home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Aminet 40
/
Aminet 40 (2000)(Schatztruhe)[!][Dec 2000].iso
/
Aminet
/
util
/
rexx
/
FWCalendar.lha
/
FWCalendar
/
FWCalendar.rexx
< prev
next >
Wrap
OS/2 REXX Batch file
|
2000-10-23
|
277KB
|
7,293 lines
/*
FWCalendar.rexx Macro
Creates calendars on FinalWriter v 4.x (SoftWood) & PageStream v 3.x
$VER: FWCalendar.rexx v4.09b (23 Oct 2000)
©Ron Goertz (goertz@earthlink.net)
*/
options results
options failat 11
signal on syntax
Numeric Digits 14
parse source . . . FullCallPath . CallHost
CallHost = strip(CallHost)
ScriptDir = PathPart(FullCallPath)
CurrentDir = upper(Pragma('D'))
if right(CurrentDir, 1) ~= ':' then CurrentDir = CurrentDir'/'
call AddLibraries
if ErrorCount > 0 then call Cleanup
address value DetermineHost()
call GetSetupInfo
if CalType < 3 then do
if CalType == 1 then do
PrevMonth = Month - 1
if PrevMonth = 0 then do
PrevMonth = 12
PrevYear = Year - 1
end
else PrevYear = Year
NextMonth = Month + 1
if NextMonth = 13 then do
NextMonth = 1
NextYear = Year + 1
end
else NextYear = Year
Calendar = Month.Month' 'EnteredYear
Mn = right(Month, 2, '0')
if DataType(Month) == 'NUM' then call setclip('FWC_CalMonth', Month)
if DataType(EnteredYear) == 'NUM' then call setclip('FWC_CalYear', EnteredYear)
call SetVariables
call MonthlyCalendar
end
else do
call SetVariables
StartMonth = Month
do MonthNumber = StartMonth to EndMonth
if MonthNumber > 12 then do
Month = MonthNumber - 12
Year = EnteredYear + 1
end
else do
Month = MonthNumber
Year = EnteredYear
end
PrevMonth = Month - 1
if PrevMonth = 0 then do
PrevMonth = 12
PrevYear = Year - 1
end
else PrevYear = Year
NextMonth = Month + 1
if NextMonth = 13 then do
NextMonth = 1
NextYear = Year + 1
end
else NextYear = Year
Calendar = Month.Month' 'EnteredYear
Mn = right(Month, 2, '0')
call MonthlyCalendar
if MonthNumber ~= EndMonth then do
if DoHide == 1 then do
REVEALWINDOW ALL
DISPLAY PAGE NEXT
HIDEWINDOW
end
else DISPLAY PAGE NEXT
end
end
end
end
else do
call SetVariables
Calendar = EnteredYear
call YearlyCalendar
end
call Cleanup
exit
/***//*** YearlyCalendar ***/
YearlyCalendar:
call MiniCalPreCalc(FYMiniCal, MiniCalWidth)
Year = EnteredYear
interpret 'StartYear = Day.'DateInfo('W', Year'0101', 'S')
YearOffset = 7 - StartYear
if YearOffset == 7 then YearOffset = 0
if (Year//4 == 0 & Year//100 > 0) | Year//400 == 0 then MonthLength.2 = 29
else MonthLength.2 = 28
CalTop = Margin.Top
do r = 0 to 3
Margin.Top = CalTop + r * (7*Height.FYMiniCal + MiniCalSpacing)
do c = 0 to 2
Month = r * 3 + c + 1
Mn = right(Month, 2, '0')
TempDate = Year''Mn'01'
if (Year//4 == 0 & Year//100 > 0) | Year//400 == 0 Then MonthLength.2 = 29
interpret 'StartDate = Day.'DateInfo('W', TempDate, 'S')
call DrawMiniCal(0, MiniCalWidth, FYMiniCal)
end
end
if DoCopyright == 1 then call RightText(PrintText(0, CalTop + 28 * Height.FYMiniCal + 3 * MiniCalSpacing, 4pt, 'N', Black$, 100, CNotice), Margin.Left + PrintWidth)
return
/**/
/***//*** MonthlyCalendar ***/
MonthlyCalendar:
if (DoSunRise ~= 0) | (DoSunSet ~= 0) then do
StartDST = DateInfo('I', Year'04'right(CalculateDate(4, 'Monday', 7), 2, '0'), 'S') /* First Sunday in April */
EndDST = DateInfo('I', Year'10'CalculateDate(10, 'Friday', 31), 'S') /* Last Sunday in October */
end
if UpdateBusy(Req, 1) == -1 then call Cleanup
TempDate = Year''Mn'01'
IDay = DateInfo('I', TempDate, 'S') - 1
interpret 'StartYear = Day.'DateInfo('W', Year'0101', 'S')
YearOffset = 7 - StartYear
if YearOffset == 7 then YearOffset = 0
if (Year//4 == 0 & Year//100 > 0) | Year//400 == 0 Then do
LeapYear = 1
MonthLength.2 = 29
end
else do
LeapYear = 0
MonthLength.2 = 28
end
if (PrevYear//4 == 0 & PrevYear//100 > 0) | PrevYear//400 == 0 Then PrevLeapYear = 1
else PrevLeapYear = 0
interpret 'StartDate = Day.'DateInfo('W', TempDate, 'S')
if (DoHighlights == 1) | (DoImages == 1) then call SetHighLights
if DoPhases ~= '' then call GetPhases(Year, Month)
if UpdateBusy(Req, 1) == -1 then call Cleanup
/* No other objects should be drawn overlapping 0,0 */
PrefsString = 'FWC'TempDate''PrefsFile
StringCount = trunc(length(PrefsString) / 25)
NextString = 0
do i = StringCount to 0 by -1
PrintString = substr(PrefsString, (i * 25) + 1, 25)
if NextString ~= 0 then PrintString = PrintString'|'NextString'|'
NextString = PrintText(0, 0, 4pt, 'N', White$, 100, PrintString)
end
if UpdateBusy(Req, 1) == -1 then call Cleanup
/***//*** Draw dates and optional highlights ***/
Day = - StartDate
GridLineTop. = CalTop
GridLineBottom. = CalTop + BoxHeight*5
GridLineLeft. = Margin.Left
GridLineRight. = CalRight
GridLineRight.6 = 0
SplitDay. = 0
MaxRow = 0
if (DoTopExtraWk ~= 1) & (trunc((StartDate + MonthLength.Month)/7) == 5) then do
do i = 1 to (StartDate + MonthLength.Month)//7
SplitDay = MonthLength.Month + 1 - i
SplitDay.SplitDay = 1
SplitDay = MonthLength.Month + 1 - i - 7
SplitDay.SplitDay = 1
end
end
Width.WidthOfDate1 = GetFontWidth(Date, 'N', '1')
Width.WidthOfDate8 = GetFontWidth(Date, 'N', '8')
if (DoRandom ~= '') & (exists(ScriptDir'FWCRandom.txt')) then do
UsedRandoms = ''
RandomFile = ReadFile(ScriptDir'FWCRandom.txt')
call openv('RandomFile')
RandomCount = length(RandomFile) - length(compress(RandomFile, '|'))
end
else DoRandom = 0
if (DoHistory ~= '') & (exists(ScriptDir'FWCHistory/'right(Month, 2, '0'))) then do
UsedRandoms = ''
RandomFile = ReadFile(ScriptDir'FWCHistory/'right(Month, 2, '0'))
end
else DoHistory = 0
Do CRow = 0 to 5
CurrentRow = CRow
if (CRow = 5) & (DoTopExtraWk == 1) then CurrentRow = 0
BoxTop = CalTop + BoxHeight*CurrentRow
if (CRow = 5) & (DoTopExtraWk ~= 1) then BoxTop = CalTop + BoxHeight*4.5
if CRow ~= 5 then MaxRow = MaxRow + 1
Do CurrentColumn = 0 to 6
Day = Day + 1
BackgroundColor = Background.Standard
if SplitDay.Day == 1 then BHeight = BoxHeight/2
else BHeight = BoxHeight
JulianDay = IDay + Day
BoxLeft = Margin.Left + BoxWidth * CurrentColumn
PrintDay = ''
/* Days for previous & next months */
If ((Day < 1) | (Day > MonthLength.Month)) then do
/* Previous month */
if Day < 1 then do
if DoExtended then PrintDay = MonthLength.PrevMonth + Day
GridLineTop.CurrentColumn = CalTop + BoxHeight
GridLineLeft.0 = Margin.Left + BoxWidth * (CurrentColumn + 1)
end
/* Next month */
else do
if DoExtended then PrintDay = Day - MonthLength.Month
interpret 'GridLineBottom.'CurrentColumn+1' = 'CalTop + BoxHeight*4
CalRow = CurrentRow + 1
if GridLineRight.CalRow == CalRight then GridLineRight.CalRow = Margin.Left + BoxWidth * CurrentColumn
end
if DoExtended then do
if (CurrentColumn = Day.Sunday | CurrentColumn = Day.Saturday) & (Background.Weekend ~= '<'Clear$'>') then BackgroundColor = Background.Weekend
DayType = 'Extended'
GridColor = Line.Extended
if BackgroundColor ~= '<'Clear$'>' then TextColor = AltColor.Extended
else TextColor = Color.Extended
end
else BackgroundColor = '<'Clear$'>'
end
/* Days for current month */
else do
if CRow ~= CurrentRow then do
GridLineTop.CurrentColumn = CalTop
interpret 'GridLineTop.'CurrentColumn+1' = 'CalTop
GridLineRight.6 = Margin.Left + BoxWidth * (CurrentColumn + 1)
end
if (CurrentColumn = Day.Sunday | CurrentColumn = Day.Saturday) & (Background.Weekend ~= '<'Clear$'>') then BackgroundColor = Background.Weekend
/* Print Highlight */
if Highlight.Month.Day ~= '' & DoHighlights == 1 then do
if TopOption ~= 0 then Highlight.Month.Day = '//'Highlight.Month.Day
DailyHLCount = 0
SearchPos = 1
Found = 1
do until Found == 0
Found = pos('//', Highlight.Month.Day, SearchPos)
if Found > 0 then do
HighlightText = substr(Highlight.Month.Day, SearchPos, Found - SearchPos)
SearchPos = Found + 2
end
else HighlightText = substr(Highlight.Month.Day, SearchPos)
ColorMarker = pos('00'x, HighlightText)
if ColorMarker > 0 then do
TextColor = left(HighlightText, ColorMarker - 1)
HighlightText = substr(Highlighttext, ColorMarker + 1)
end
else TextColor = ''
/* Draw background colors for highlight days */
if (right(HighlightText, 1) == '#') & (Background.HighlightH ~= '<'Clear$'>') then do
BackgroundColor = Background.HighlightH
if (TextColor == '') | (TextColor == '<'Clear$'>') then do
if (BackgroundColor ~= White$) then TextColor = AltColor.HighlightH
else TextColor = Color.HighlightH
end
end
else if Background.Highlight ~= '<'Clear$'>' then do
BackgroundColor = Background.Highlight
if (TextColor == '') | (TextColor == '<'Clear$'>') then do
if (BackgroundColor ~= White$) then TextColor = AltColor.Highlight
else TextColor = Color.Highlight
end
end
if (TextColor == '') | (TextColor == '<'Clear$'>') then do
if right(HighlightText, 1) == '#' then TextColor = Color.HighlightH
else TextColor = Color.Highlight
end
if DoDateBox == 1 then HighlightOffset = CurveOffset + 1.25 * DateOffset + 2 * Width.WidthOfDate8
else do
Select
when Day < 10 then HighlightOffset = Width.WidthOfDate1 / 2 + Width.WidthOfDate8
when Day < 20 then HighlightOffset = 1.5 * Width.WidthOfDate1 + Width.WidthOfDate8
otherwise HighlightOffset = Width.WidthOfDate1 / 2 + 2 * Width.WidthOfDate8
end
end
call PrintHighlight(compress(HighlightText, '#'), 'Highlight')
DailyHLCount = DailyHLCount + 1
end
end
else do
if DoDailyColors == 1 then do
Select
when CurrentColumn == Day.Sunday then TextColor = Color.Sunday
when CurrentColumn == Day.Monday then TextColor = Color.Monday
when CurrentColumn == Day.Tuesday then TextColor = Color.Tuesday
when CurrentColumn == Day.Wednesday then TextColor = Color.Wednesday
when CurrentColumn == Day.Thursday then TextColor = Color.Thursday
when CurrentColumn == Day.Friday then TextColor = Color.Friday
when CurrentColumn == Day.Saturday then TextColor = Color.Saturday
end
end
else if BackgroundColor ~= '<'Clear$'>' then TextColor = AltColor.Date
else TextColor = Color.Date
end
if DoMatchColors ~= 1 then do
if DoDailyColors == 1 then do
Select
when CurrentColumn == Day.Sunday then TextColor = Color.Sunday
when CurrentColumn == Day.Monday then TextColor = Color.Monday
when CurrentColumn == Day.Tuesday then TextColor = Color.Tuesday
when CurrentColumn == Day.Wednesday then TextColor = Color.Wednesday
when CurrentColumn == Day.Thursday then TextColor = Color.Thursday
when CurrentColumn == Day.Friday then TextColor = Color.Friday
when CurrentColumn == Day.Saturday then TextColor = Color.Saturday
end
end
else if BackgroundColor ~= '<'Clear$'>' then TextColor = AltColor.Date
else TextColor = Color.Date
end
/* Print Day */
DayType = 'Normal'
PrintDay = Day
GridColor = Line.Grid
end
if PrintDay ~= '' then do
if DoDateBox == 1 then do
if PrintDay < 10 then LeftEdge = BoxLeft + CurveOffset + Width.WidthOfDate8
else LeftEdge = BoxLeft + CurveOffset
end
else LeftEdge = BoxLeft + CurveOffset
DayID = PrintText(LeftEdge, BoxTop, Date, 'N', TextColor, Width.Date, PrintDay)
if DoDateBox == 1 then call BoxDate(TextColor)
if CRadius ~= 0 then
call DrawBox(BoxLeft, BoxTop, BoxWidth, BHeight, 'HL', GridColor, 0, , (DayType == 'Extended'), CRadius)
call DoOptions
end
if BackgroundColor ~= '<'Clear$'>' then
call DrawBox(BoxLeft, BoxTop, BoxWidth, BHeight, 0, , 1, BackgroundColor, 1, CRadius)
if UpdateBusy(Req, 1) == -1 then call Cleanup
if (CRow == 5) & (Day == MonthLength.Month) then leave CRow
end
if Day >= MonthLength.Month then leave
end
call closev('RandomFile')
/**/
/***//*** Draw grids ***/
LowRow = CRow
if LowRow = 3 then GridLineBottom. = CalTop + BoxHeight*4
/* Draw note box */
drop TopNoteLeft
drop TopNoteRight
drop BottomNoteLeft
drop BottomNoteRight
if DoNoteBox then do
PrevTop = CalTop
PrevBottom = GridLineBottom.
do i = 0 to 7
if GridLineTop.i > PrevTop then TopNoteLeft = max(i - 1, 0)
if GridLineTop.i < PrevTop then TopNoteRight = i
PrevTop = GridLineTop.i
end
do i = 0 to 7
if GridLineBottom.i < PrevBottom then BottomNoteLeft = max(i - 1, 0)
if GridLineBottom.i > PrevBottom then BottomNoteRight = i
PrevBottom = GridLineBottom.i
end
if (symbol('TopNoteLeft') == 'LIT') & (symbol('TopNoteRight') == 'LIT') then do
TopNoteleft = 0
TopNoteRight = 0
end
if (symbol('BottomNoteLeft') == 'LIT') & (symbol('BottomNoteRight') == 'LIT') then do
BottomNoteleft = 0
BottomNoteRight = 0
end
if (symbol('BottomNoteLeft') == 'VAR') & (symbol('BottomNoteRight') == 'LIT') then BottomNoteRight = 7
if TopNoteRight ~= TopNoteLeft then do
LeftEdge = Margin.Left + BoxWidth*TopNoteLeft
RightEdge = Margin.Left + BoxWidth*TopNoteRight
if CornerRadius == 0 then do
call DrawLine(LeftEdge, CalTop, RightEdge, CalTop, 'HL', Line.NoteBox)
if TopNoteLeft == 0 then call DrawLine(Margin.Left, CalTop, Margin.Left, GridLineTop.0, 'HL', Line.NoteBox)
end
else call DrawBox(LeftEdge, CalTop, RightEdge - LeftEdge, BoxHeight, 'HL', Line.NoteBox, 0, , 1, CRadius)
if Background.NoteBox ~= '<'Clear$'>' then
call DrawBox(LeftEdge, CalTop, RightEdge - LeftEdge, BoxHeight, 0, , 1, Background.NoteBox, 1, CRadius)
call PrintText(LeftEdge + CurveOffset, CalTop, Date, 'N', Color.NoteBox, Width.Date, Note$':')
end
if BottomNoteRight ~= BottomNoteLeft then do
LeftEdge = Margin.Left + BoxWidth*BottomNoteLeft
RightEdge = Margin.Left + BoxWidth*BottomNoteRight
if CornerRadius == 0 then do
call DrawLine(LeftEdge, GridLineBottom.BottomNoteLeft, RightEdge, GridLineBottom.BottomNoteLeft, 'HL', Line.NoteBox)
call DrawLine(RightEdge, GridLineBottom.BottomNoteLeft, RightEdge, GridLineBottom.BottomNoteRight, 'HL', Line.NoteBox)
end
else call DrawBox(LeftEdge, GridLineBottom.BottomNoteRight, RightEdge - LeftEdge, BoxHeight, 'HL', Line.NoteBox, 0, , 1, CRadius)
if Background.NoteBox ~= '<'Clear$'>' then
call DrawBox(LeftEdge, GridLineBottom.BottomNoteRight, RightEdge - LeftEdge, BoxHeight, 0, , 1, Background.NoteBox, 1, CRadius)
call PrintText(LeftEdge + CurveOffset, GridLineBottom.BottomNoteRight, Date, 'N', Color.NoteBox, Width.Date, Note$':')
end
end
if CornerRadius == 0 then do
/* Draw vertical grid */
do i = 0 to 7
LeftEdge = Margin.Left + BoxWidth*i
if DoExtended then do
if GridLineTop.i > CalTop then
call DrawLine(LeftEdge, CalTop, LeftEdge, GridLineTop.i, 'HL', Line.Extended)
if GridLineBottom.i < GridLineBottom.8 then
call DrawLine(LeftEdge, GridLineBottom.i, LeftEdge, GridLineBottom.8, 'HL', Line.Extended)
end
call DrawLine(LeftEdge, GridLineTop.i, LeftEdge, GridLineBottom.i, 'HL', Line.Grid)
end
/* Draw horizontal grid */
do i = 0 to min(LowRow + 1, 5)
TopEdge = CalTop + BoxHeight * i
if DoExtended then do
if GridLineLeft.i > Margin.Left then
call DrawLine(Margin.Left, TopEdge, GridLineLeft.i, TopEdge, 'HL', Line.Extended)
if GridLineRight.i < CalRight then
call DrawLine(GridLineRight.i, TopEdge, CalRight, TopEdge, 'HL', Line.Extended)
end
call DrawLine(GridLineLeft.i, TopEdge, GridLineRight.i, TopEdge, 'HL', Line.Grid)
end
if (trunc((StartDate + MonthLength.Month)/7) == 5) & (DoTopExtraWk == 0) then
call DrawLine(Margin.Left, CalTop + BoxHeight * 4.5, Margin.Left + BoxWidth * ((StartDate + MonthLength.Month)//7), CalTop + BoxHeight * 4.5, 'HL', Line.Grid)
if GridLineRight.6 ~= 0 then call DrawLine(Margin.Left, CalTop, GridLineRight.6, CalTop, 'HL', Line.Grid)
end
if CalendarBorder ~= 0 then
call DrawBox(Margin.Left - CalendarBorder, CalTop - CalendarBorder, PrintWidth + 2 * CalendarBorder, MaxRow * BoxHeight + 2 * CalendarBorder, 'HL', Line.CalBorder, 0, , 1, CRadius)
if CalendarShadow ~= 0 then do
if ShadowType == 'P' then do
call DrawBox(Margin.Left + PrintWidth + CalendarBorder, CalTop - CalendarBorder + CalendarShadow, CalendarShadow, MaxRow * BoxHeight + 2 * CalendarBorder, 0, , 1, Background.CalShadow, 1, 0)
call DrawBox(Margin.Left - CalendarBorder + CalendarShadow, CalTop + MaxRow * BoxHeight + CalendarBorder, PrintWidth + 2 * CalendarBorder, CalendarShadow, 0, , 1, Background.CalShadow, 1, 0)
end
else call DrawBox(Margin.Left - CalendarBorder + CalendarShadow, CalTop - CalendarBorder + CalendarShadow, PrintWidth + 2 * CalendarBorder, MaxRow * BoxHeight + 2 * CalendarBorder, 0, , 1, Background.CalShadow, 1, CRadius)
end
/**/
/***//*** Draw headers & minicals ***/
/* Create month/year header */
if Header$ ~= '' then do
Text.Top = Margin.Top + TextArea * HeaderLoc
call CenterText(PrintText(Margin.Left, Text.Top , Header, 'N', Color.Header, Width.Header, BuildString(Header$, HeaderVars)), Margin.Left + PrintWidth/2, .9 * (PrintWidth - DoMiniCals * (2 * MiniCalWidth)), 0)
if UpdateBusy(Req, 1) == -1 then call Cleanup
end
if SubHeader$ ~= '' then do
Text.Top = Margin.Top + TextArea * SubHeaderLoc
call CenterText(PrintText(Margin.Left, Text.Top , SubHeader, 'N', Color.SubHeader, Width.SubHeader, BuildString(SubHeader$, SubHeaderVars)), Margin.Left + PrintWidth/2, .9 * (PrintWidth - DoMiniCals * (2 * MiniCalWidth)), 0)
if UpdateBusy(Req, 1) == -1 then call Cleanup
end
/* Create weekday titles */
Text.Top = CalTop - (Height.Weekday * 1.15) - CalendarBorder
Do i = 0 to 6
WeekdayID.i = PrintText(1, Text.Top, Weekday, 'N', Color.Weekday, Width.Weekday, Day.i)
if UpdateBusy(Req, 1) == -1 then call Cleanup
End
/* Position weekday titles */
MaxWidth = GetMaxWidth('WeekdayID', 6)
if MaxWidth == 0 then MaxWidth = BoxWidth
Do i = 0 to 6
call CenterText(WeekdayID.i, Margin.Left + (i + .5) * BoxWidth, 0, .9 * min(1, BoxWidth/MaxWidth))
if UpdateBusy(Req, 1) == -1 then call Cleanup
end
if DoMiniCals = 1 then do
call MiniCalPreCalc(MiniCal, MiniCalWidth)
call DrawMiniCal(-1, MiniCalWidth, MiniCal)
call DrawMiniCal(+1, MiniCalWidth, MiniCal)
end
/**/
if DoCopyright == 1 then call RightText(PrintText(0, Margin.Top + PrintHeight + 2 * CalendarBorder + CalendarShadow, 4pt, 'N', Black$, 100, CNotice), Margin.Left + PrintWidth)
if App == 'PGS' then SELECTOBJECT NONE
return
/**/
/*** Subroutines ***/
/***//*** AddBGUI (AB) ***/
AddBGUI:
i = 0; AL_RexxBGUILib = i; AL_Lib.i = 'rexxbgui.library'; AL_MinVersion.i = 4; AL_Offset.i = -30; AL_Variable.i = 'RexxBGUILib'; AL_Status.i = "E"
i = 1; AL_BGUILib = i; AL_Lib.i = 'bgui.library'; AL_MinVersion.i = 41.1; AL_Offset.i = '' ; AL_Variable.i = 'BGUILib'; AL_Status.i = "E"
do i = 0 to 1
if exists('LIBS:'AL_lib.i) then do
AL_InstalledVersion = PgmVer('LIBS:'AL_lib.i)
AL_LibCount = AL_LibCount + 1
Library.Name.AL_LibCount = AL_Lib.i
Library.Version.AL_LibCount = AL_InstalledVersion
if (AL_InstalledVersion < AL_MinVersion.i) | (AL_InstalledVersion == '') then do
call AddMsg(AL_Status.i, AL_Lib.i' version 'AL_MinVersion.i' is required; your version is 'AL_InstalledVersion'.')
interpret Al_Variable.i' = 0'
end
else do
if i ~= AL_BGUILib then call addlib(AL_lib.i, 0, AL_Offset.i, trunc(AL_MinVersion.i))
interpret Al_Variable.i' = 1'
end
end
else do
interpret Al_Variable.i' = 0'
if (i = AL_RexxBGUILib) | (i = AL_BGUILib) then do
if GUIWarning == 0 then do
GUIWarning = 1
call AddMsg('E', 'Either the ClassAct files or the BGUI files (see the docs)')
call AddMsg('E', ' must be installed. Neither could be found...')
end
end
else if AL_Status.i == 'E' then call AddMsg('E', AL_lib.i' is required but could not be found.')
end
end
if RexxBGUILib == 1 then ClassAct = 0
if (ClassAct == 0) & (bguiopen = 0) then bguiopen = bguiopen()
return
/**/
/***//*** AddLibraries (AL) ***/
AddLibraries:
AL_LibCount = 0
DoingCleanup = 0
PortList = show('P')
InformationCount = 0
WarningCount = 0
ErrorCount = 0
HostScreen = ''
Req = 0
bguiopen = 0
Storage = 'RAM:FWC/'
ClassAct = 0
ForceBGUI = 0
ReqAPVersion = 2.48
ReqCAVersion = 42.80
ClassActMessage = ''
AWNPipeMessage = ''
GUIWarning = 0
call TranslationStrings
interpret ReadFile(ScriptDir'FWCTranslations.txt')
i = 0; AL_DateLib = i; AL_Lib.i = 'date.library'; AL_MinVersion.i = 33.31; AL_Offset.i = -492; AL_Variable.i = 'DateLib'; AL_Status.i = "W"
i = 1; AL_RexxMathLib = i; AL_Lib.i = 'rexxmathlib.library'; AL_MinVersion.i = 38.1; AL_Offset.i = -30; AL_Variable.i = 'RexxMathLib'; AL_Status.i = "W"
if exists('L:awnpipe-handler') == 1 then do
AWNPipeVersion = PgmVer('L:awnpipe-handler')
if exists('LIBS:gadgets/layout.gadget') == 1 then do
ClassActVersion = PgmVer('LIBS:gadgets/layout.gadget')
if ClassActVersion < ReqCAVersion then do
ClassActMessage = 'ClassAct version 'ReqCAVersion'+ is required; your version is 'ClassActVersion'. BGUI is being used'
ForceBGUI = 1
end
if AWNPipeVersion < ReqAPVersion then do
AWNPipeMessage = 'AWNPipe version 'ReqAPVersion'+ is required; your version is 'AWNPipeVersion'. BGUI is being used'
ForceBGUI = 1
end
if ForceBGUI == 0 then ClassAct = 1
end
else ForceBGUI = 1
end
else ForceBGUI = 1
do i = 0 to 1
if exists('LIBS:'AL_lib.i) then do
AL_InstalledVersion = PgmVer('LIBS:'AL_lib.i)
AL_LibCount = AL_LibCount + 1
Library.Name.AL_LibCount = AL_Lib.i
Library.Version.AL_LibCount = AL_InstalledVersion
if (i == AL_RexxMathLib) & (AL_InstalledVersion == '38.02') then AL_InstalledVersion = 38.2
if (AL_InstalledVersion < AL_MinVersion.i) | (AL_InstalledVersion == '') then do
call AddMsg(AL_Status.i, AL_Lib.i' version 'AL_MinVersion.i' is required; your version is 'AL_InstalledVersion'.')
interpret Al_Variable.i' = 0'
end
else do
call addlib(AL_lib.i, 0, AL_Offset.i, trunc(AL_MinVersion.i))
interpret AL_Variable.i' = 1'
end
end
else do
interpret Al_Variable.i' = 0'
if AL_Status.i == 'E' then call AddMsg('E', AL_lib.i' is required but could not be found.')
end
end
if (DateLib == 1) | (RexxMathLib == 1) then PhaseLib = 1
else PhaseLib = 0
if ForceBGUI == 1 then do
ClassAct = 0
call AddBGUI
end
if ErrorCount > 0 then call Cleanup
return
/**/
/***//*** AddMsg (AM) ***/
AddMsg:
parse arg AM_MsgType, AM_Msg
if AM_MsgType == 'E' then do
if symbol('ErrorCount') == 'LIT' then ErrorCount = 0
ErrorCount = ErrorCount + 1
Error.ErrorCount = AM_Msg
end
else if AM_MsgType == 'W' then do
if symbol('WarningCount') == 'LIT' then WarningCount = 0
WarningCount = WarningCount + 1
Warning.WarningCount = AM_Msg
end
else do
if symbol('InformationCount') == 'LIT' then InformationCount = 0
InformationCount = InformationCount + 1
Information.InformationCount = AM_Msg
end
return 0
/**/
/***//*** AssignHighlight (AH) ***/
AssignHighlight:
parse arg AH_Month, AH_Day, AH_Event, AH_Color
if upper(left(AH_Month, 9)) == 'HIGHLIGHT' then parse var AH_Month .'.'AH_Month'.'AH_Day'='AH_Event','AH_Color
if strip(AH_Event, 'B', '"'||"'") == '' then return 0
if AH_Month = 13 then AH_Month = Mn - 0
if AH_Color == '' then AH_Color = '<'Clear$'>'
AH_Event = strip(AH_Color, 'B', '" '||"'")||'00'x||substr(strip(AH_Event), 2, Length(strip(AH_Event)) - 2)
AH_DateString = DetermineDate(strip(AH_Month), strip(AH_Day), Year)
AH_Month = word(AH_DateString, 1)
AH_Day = word(AH_DateString, 2)
if Highlight.AH_Month.AH_Day == '' then Highlight.AH_Month.AH_Day = AH_Event
else Highlight.AH_Month.AH_Day = Highlight.AH_Month.AH_Day'//'AH_Event
HighlightCount = HighlightCount + 1
do AH_i = 0 to ImageClass.Count - 1
if pos(upper(ImageClass.AH_i), upper(AH_Event)) > 0 then do
Image.AH_Month.AH_Day = AH_i
ImageCount = ImageCount + 1
leave
end
end
return 0
/**/
/***//*** AssignID (AID) ***/
AssignID:
parse arg AID_Var, AID_ID
interpret AID_Var' = 'AID_ID
DSR_Gad.AID_ID = AID_Var
if left(AID_Var, 3) = 'Gad' then AID_Var = 'Extra'substr(AID_Var, 5, 1)
DSR_Help.AID_ID = AID_Var'Help'
return
/**/
/***//*** AssignImage (AI) ***/
AssignImage:
parse arg AI_Month, AI_Day, AI_Image
if DoImages ~= 1 then return 0
if upper(left(AI_Month, 5)) == 'IMAGE' then do
parse var AI_Month .'.'AI_Month'.'AI_Day'='AI_Image
AI_Image = substr(AI_Image, 2, Length(AI_Image) - 2)
end
AI_Image = strip(AI_Image, 'B', '" '||"'")
parse var AI_Image AI_Image ',' AI_DX ',' AI_DY
if (pos('/', AI_Image) == 0) & (pos(':', AI_Image) == 0) then AI_Image = ScriptDir'Images/'strip(AI_Image, 'B', ' "'||"'")
AI_DX = strip(AI_DX);if AI_DX == '' then AI_DX = 0
AI_DY = strip(AI_DY);if AI_DY == '' then AI_DY = 0
AI_DateString = DetermineDate(strip(AI_Month), strip(AI_Day), Year)
AI_Month = word(AI_DateString, 1)
AI_Day = word(AI_DateString, 2)
if exists(AI_Image) then do
ICCount = ImageClass.Count
Image.AI_Month.AI_Day = ICCount
ImageClass.ICCount = ''
ImageFile.ICCount = AI_Image
ImageDX.ICCount = AI_DX
ImageDY.ICCount = AI_DY
ImageClass.Count = ImageClass.Count + 1
end
return 0
/**/
/***//*** BoxDate (BD) ***/
BoxDate:
parse arg BD_DateBoxColor
BD_DateBoxHeight = Height.Date
call DrawBox(BoxLeft, BoxTop, CurveOffset + 2 * Width.WidthOfDate8 + DateOffset, BD_DateBoxHeight, 'HL', BD_DateBoxColor, 0, 0, 1, CRadius)
return
/**/
/***//*** BuildString (BS) ***/
BuildString:
parse arg BS_String, BS_Values
do BS_i = 1 to words(BS_Values)
InsertPos = pos('%s', BS_String)
if InsertPos == 0 then leave
interpret "BS_String = left(BS_String, InsertPos - 1)''"word(BS_Values, BS_i)"''substr(BS_String, InsertPos + 2)"
end
return BS_String
/**/
/***//*** BuryObject (BO) ***/
BuryObject:
parse arg BO_Object
if App == 'FW' then OBJECTTOBACK BO_Object
else if App == 'PGS' then do
parse arg BO_Object
SENDTOBACK OBJECTID BO_Object WINDOW winName
end
return BO_Object
/**/
/***//*** BusyReq (BR) ***/
/***//*** OpenBusy ***/
OpenBusy:
parse arg BR_BusyTitle, BR_EventCount
BR_Progress = 0
if ClassAct == 1 then do
call open('ProgReq', "awnpipe:ProgressReq/xc")
call ToPIPE('ProgReq', 'm v cs si so a ps="'AppScreen'"')
call ToPIPE('ProgReq', 'label gt="'BR_BusyTitle', 'PleaseWait$'..."')
BR_ProgressGad = ToPIPE('ProgReq', 'fuelgauge defn=0 maxn='BR_EventCount' t=0 per')
call ToPIPE('ProgReq', 'layout b=0 si so cj')
call ToPIPE('ProgReq', 'space')
BR_CancelGad = ToPIPE('ProgReq', 'button pb gt="'Cancel$'"')
call ToPIPE('ProgReq', 'space')
call ToPIPE('ProgReq', 'le')
if ToPIPE('ProgReq', 'open') == 'window' then BR_ProgressWindow = 1
else BR_ProgressWindow = 0
end
else do
BR_ProgressGroup=bguivgroup(,
bguiinfo('BR_dummy',,'1B'x||'c'BR_BusyTitle', 'PleaseWait$'...')bguilayout(LGO_FixMinHeight,1)||,
bguiprogress('BR_prog2_',,0,BR_EventCount)||,
bguihgroup(,
bguivarspace(50)bguilayout(LGO_FixMinHeight,1)||,
bguibutton('BR_cancel_',Cancel$)bguilayout(LGO_FixMinHeight,1)||,
bguivarspace(50)bguilayout(LGO_FixMinHeight,1),
,,,,'W'),
,-2,-2)
BR_ProgressWindow = bguiwindow('',BR_ProgressGroup,,2,,AppScreen)
if bguiwinopen(BR_ProgressWindow) = 0 then call Cleanup
end
return BR_ProgressWindow
/**/
/***//*** UpdateBusy ***/
UpdateBusy:
parse arg BR_ReqWin, BR_ProgressMade
if BR_ReqWin == 0 then return 0
BR_Progress = BR_Progress + BR_ProgressMade
/* say '>'BR_Progress SIGL */
if ClassAct == 1 then do
if show('F', 'ProgReq') == 1 then do
call writeln('ProgReq', 'id 'BR_CancelGad' read')
BR_CancelStatus = readln('ProgReq')
if BR_CancelStatus == 1 then do
call CloseBusy('ProgReq')
return -1
end
end
else return 0
if show('F', 'ProgReq') == 1 then do
call ToPIPE('ProgReq', 'id 0 s=2')
call writeln('ProgReq', 'id 'BR_ProgressGad' defn='BR_Progress' ref')
call readln('ProgReq')
end
else return 0
end
else do
call bguiset(obj.BR_prog2_,BR_ReqWin,PROGRESS_Done,BR_Progress)
if bguiwinevent(BR_ReqWin,'ID') == id.BR_cancel_ then return -1
end
return BR_Progress
/**/
/***//*** CloseBusy ***/
CloseBusy:
parse arg BR_ReqWin
if BR_ReqWin == 0 then return 0
if ClassAct == 1 then call close('ProgReq')
else call bguiwinclose(BR_ReqWin)
Req = 0
return 0
/**/
/**/
/***//*** CalculateDate (CD) ***/
CalculateDate:
/* Month is the month in which the highlight occurs */
/* HighDate is the highest (numerical) date on which the highlight will occur */
/* HighDay is the weekday on which the month starts when HighDate will occur */
/* Event is the highlight text */
parse arg CD_Month, CD_HighDay, CD_HighDate, CD_Event, CD_Color
CD_Event = QuoteIt(CD_Event)
if CD_Month = 13 then CD_Month = Mn - 0
if datatype(CD_HighDate) == 'CHAR' then do
CD_HighDate = upper(left(CD_HighDate, 1))
interpret 'CD_EventOffset = Day.'CD_HighDay' - StartDate'
CD_Day = 1 + CD_EventOffset
if CD_Day < 1 then CD_Day = CD_Day + 7
do until CD_Day > Monthlength.Month
CD_WN = trunc((right(DateInfo('J', Year''right(CD_Month, 2, '0')''right(CD_Day, 2, '0'), 'S'), 3) - YearOffset - 1)/7 + 1)
if CD_HighDate == 'A' then call AssignHighlight(CD_Month, CD_Day, CD_Event, CD_Color)
else if (CD_HighDate == 'E') & (CD_WN//2 == 0) then call AssignHighlight(CD_Month, CD_Day, CD_Event, CD_Color)
else if (CD_HighDate == 'O') & (CD_WN//2 == 1) then call AssignHighlight(CD_Month, CD_Day, CD_Event, CD_Color)
CD_Day = CD_Day + 7
end
end
else do
interpret 'CD_HighDay = Day.'CD_HighDay
interpret 'CD_First = Day.'DateInfo('W', Year''right(CD_Month, 2, '0')'01', 'S')
CD_Day = CD_HighDate + (CD_HighDay - CD_First)
if CD_First < CD_HighDay then CD_Day = CD_Day - 7
if CD_Event ~= '' then call AssignHighlight(CD_Month, CD_Day, CD_Event, CD_Color)
end
return CD_Day
/**/
/***//*** CalculateEDate (CED) ***/
CalculateEDate:
/* DaysPastEaster is the number of days past Easter when the event occurs */
/* Event is the highlight text */
parse arg CED_DaysPastEaster, CED_EasterEvent, CED_Color
CED_EasterEvent = '"'CED_EasterEvent'"'
CED_EasterEventDate = DateInfo('S', EasterSerial + CED_DaysPastEaster, 'I')
CED_EasterEventMonth = strip(substr(CED_EasterEventDate, 5, 2), 'L', '0')
CED_EasterEventDay = strip(right(CED_EasterEventDate, 2), 'L', '0')
call AssignHighlight(CED_EasterEventMonth, CED_EasterEventDay, CED_EasterEvent, CED_Color)
return 0
/**/
/***//*** CalculateImage (CI) ***/
CalculateImage:
/* Month is the month in which the highlight occurs */
/* HighDate is the highest (numerical) date on which the highlight will occur */
/* HighDay is the weekday on which the month starts when HighDate will occur */
/* Event is the highlight text */
parse arg CI_Month, CI_HighDay, CI_HighDate, CI_Image
if DoImages ~= 1 then return 0
if CI_Month = 13 then CI_Month = Mn - 0
if datatype(CI_HighDate) == 'CHAR' then do
CI_HighDate = upper(left(CI_HighDate, 1))
interpret 'CI_EventOffset = Day.'CI_HighDay' - StartDate'
CI_Day = 1 + CI_EventOffset
if CI_Day < 1 then CI_Day = CI_Day + 7
do until CI_Day > Monthlength.Month
CI_WN = trunc((right(DateInfo('J', Year''right(CI_Month, 2, '0')''right(CI_Day, 2, '0'), 'S'), 3) - YearOffset - 1)/7 + 1)
if CI_HighDate == 'A' then call AssignImage(CI_Month, CI_Day, CI_Image)
else if (CI_HighDate == 'E') & (CI_WN//2 == 0) then call AssignImage(CI_Month, CI_Day, CI_Image)
else if (CI_HighDate == 'O') & (CI_WN//2 == 1) then call AssignImage(CI_Month, CI_Day, CI_Image)
CI_Day = CI_Day + 7
end
end
else do
interpret 'CI_HighDay = Day.'CI_HighDay
interpret 'CI_First = Day.'DateInfo('W', Year''right(CI_Month, 2, '0')'01', 'S')
CI_Day = CI_HighDate + (CI_HighDay - CI_First)
if CI_First < CI_HighDay then CI_Day = CI_Day - 7
if CI_Event ~= '' then call AssignImage(CI_Month, CI_Day, CI_Image)
else return CI_Day
end
return 0
/**/
/***//*** CAGetFile (GF) ***/
CAGetFile:
parse arg GF_FileHandle, GF_GadID, GF_Title, GF_InitDir
call writeln(GF_FileHandle,'id 'GF_GadID' gt="'GF_Title':" fn="'GF_InitDir'" s=1')
GF_GetFileResult = readln(GF_FileHandle)
parse var GF_GetFileResult GF_OK GF_Choice GF_File
if GF_Choice ~= 0 then GF_File = strip(GF_File, 'B', '" ')
else GF_File = ''
return GF_File
/**/
/***//*** CASimpleReq (CAS) ***/
CASimpleReq:
parse arg CAS_Title, CAS_Msg, CAS_Time
if CAS_Time == '' then do
CAS_Msg = translate(CAS_Msg, "'", '"')
do while pos('0a'x, CAS_Msg) > 0
CAS_Msg = left(CAS_Msg, pos('0a'x, CAS_Msg) - 1)'*n'substr(CAS_Msg, pos('0a'x, CAS_Msg) + 1)
end
call open('Req', "awnpipe:SimpleReq/xc")
call ToPIPE('Req', '"'CAS_Title'" v db dg si so a ps="'AppScreen'"')
call ToPIPE('Req', 'label gt="'CAS_Msg'"')
call ToPIPE('Req', 'layout b=0 si so cj')
call ToPIPE('Req', 'space')
call ToPIPE('Req', 'button c gt="'OK$'"')
call ToPIPE('Req', 'space')
call ToPIPE('Req', 'le')
call ToPIPE('Req', 'open')
do while ~eof('Req')
call readln('Req')
end
call close('Req')
end
else do
call open('Req', "awnpipe:SimpleReq/xc")
call ToPIPE('Req', 'm sk si so a ps="'AppScreen'"')
call ToPIPE('Req', 'label gt="'CAS_Msg'"')
call ToPIPE('Req', 'open')
CAS_TickCount = 0
do until CAS_TickCount >= CAS_Time
call ToPIPE('Req', 'tick 100')
Req_EventInfo = readln('Req')
parse var Req_EventInfo Req_Event' 'Req_GadID' 'Req_GadInfo1
select
when Req_Event == 'key' then CAS_TickCount = CAS_Time
when Req_Event = 'tick' then CAS_TickCount = CAS_TickCount + 1
otherwise nop
end
end
call close('Req')
end
return
/**/
/***//*** CenterText (CT) ***/
CenterText:
parse arg CT_id, CT_CenterPoint, CT_MaxWidth, CT_WidthPercent
if App == 'FW' then do
GETOBJECTCOORDS CT_id; Parse Var result . . CT_Text.Bottom CT_Text.Width CT_Text.Height
if CT_MaxWidth ~= 0 then CT_Text.Width = min(CT_Text.Width, CT_MaxWidth)
else CT_Text.Width = CT_Text.Width * CT_WidthPercent
CT_Text.Left = CT_CenterPoint - CT_Text.Width/2
SETOBJECTCOORDS CT_id 1 CT_Text.Left CT_Text.Bottom CT_Text.Width CT_Text.Height
end
else if App == 'PGS' then do
GETTEXTOBJ POSITION CT_Text OBJECTID CT_id WINDOW winName
CT_Text.Width = CT_Text.Right - CT_Text.Left
if CT_MaxWidth ~= 0 then CT_Text.Width = min(CT_Text.Width, CT_MaxWidth)
else CT_Text.Width = CT_Text.Width * CT_WidthPercent
CT_Text.Left = CT_CenterPoint - CT_Text.Width/2
EDITTEXTOBJ POSITION CT_Text.Left CT_Text.Top (CT_Text.Left + CT_Text.Width) CT_Text.Bottom OBJECTID CT_id WINDOW winName
end
return CT_id
/**/
/***//*** CheckDir (PROCEDURE) ***/
CheckDir: PROCEDURE
parse arg Dir
address command 'assign >NIL: FWC: 'Dir
if RC == 20 then return ''
else do
address command 'assign >NIL: FWC:'
return Dir
end
return
/**/
/***//*** Cleanup () ***/
Cleanup:
signal off syntax
DoingCleanup = 1
call close('DataFile')
call close('CA')
call CloseBusy(Req)
if App == 'FW' then do
SELECTOBJECT
VIEW FinalView
if VariablesSet == 1 then do
interpret UserPrefs
if upper(DecimalFormat) = 'COMMA' then DOCITEMPREFS DECIMAL Comma
end
end
else if App == 'PGS' then do
if VariablesSet == 1 then interpret UserPrefs
LOCKINTERFACE FALSE
LOADSETTINGS default
REFRESH ON
REFRESHWINDOW WINDOW winName
DISPLAY SCALE FinalView WINDOW winName
DISPLAY PAGE 1
REVEALWINDOW ALL
end
if (ErrorCount == 0) & (CalType < 3) & (LaunchM ~= '') then interpret LaunchM
if (ErrorCount == 0) & (CalType == 3) & (LaunchY ~= '') then interpret LaunchY
LogOpen = open('FWCLog', Storage'FWCLog.txt', 'W')
if LogOpen == 0 then do
address command 'makedir >NIL: 'left(Storage, length(Storage) - 1)
LogOpen = open('FWCLog', Storage'FWCLog.txt', 'W')
end
if LogOpen == 1 then OutType = 'File'
if ((WarningCount > 0) | (ErrorCount > 0)) & (LogOpen == 0) then do
LogOpen = 1
call open('FWCLog', 'CON:10/10/500/300/FWCalendar.rexx Message/WAIT/CLOSE')
OutType = 'CON'
end
if LogOpen == 1 then do
call writeln('FWCLog', ' Macro: 'strip(substr(sourceline(4), pos(':', sourceline(4)) + 1)))
call writeln('FWCLog', 'Application: 'NameAndVersion)
call writeln('FWCLog', 'Current Dir: 'CurrentDir)
call writeln('FWCLog', ' Script Dir: 'ScriptDir)
call writeln('FWCLog', ' Host: 'CallHost)
call writeln('FWCLog', ' Calendar: 'Calendar||'0a'x)
interpret 'address command "version >PIPE:FWC"'
Ln = ReadFile('PIPE:FWC')
KS = strip(word(Ln, 2), 'B', ' ,')
WB = strip(word(Ln, 4))
interpret 'address command "cpu >PIPE:FWC"'
CPULn = ReadFile('PIPE:FWC')
CPU = strip(word(CPULn, 2))
interpret 'address command "avail >PIPE:FWC"'
AvailLn = ReadFile('PIPE:FWC')
call OpenV('AvailLn')
call readvln('AvailLn')
ChipRAM = strip(word(readvln('AvailLn'), 2))
FastRAM = strip(word(readvln('AvailLn'), 2))
call CloseV('AvailLn')
MaxLen = max(length(ChipRAM), length(FastRAM))
call writeln('FWCLog', ' Kickstart: 'KS)
call writeln('FWCLog', ' Workbench: 'WB)
call writeln('FWCLog', ' CPU: 'CPU)
call writeln('FWCLog', ' Chip RAM: 'right(ChipRAM, MaxLen)' available')
call writeln('FWCLog', ' Fast RAM: 'right(FastRAM, MaxLen)' available')
if AL_LibCount > 0 then do
call writeln('FWCLog', ' Libraries: 'left(Library.Name.1, 21)'v'Library.Version.1)
do i = 2 to AL_LibCount
call writeln('FWCLog', ' 'left(Library.Name.i, 21)'v'Library.Version.i)
end
call writeln('FWCLog', '')
end
else call writeln('FWCLog', '0a'x||'No libraries added.')
if AWNPipeMessage ~= '' then call writeln('FWCLog', AWNPipeMessage)
if ClassActMessage ~= '' then call writeln('FWCLog', ClassActMessage)
call writeln('FWCLog', '')
end
if (ErrorCount > 0) | (WarningCount > 0) | (InformationCount > 0) then do
do i = 1 to ErrorCount
call writeln('FWCLog', 'Error: 'Error.i)
end
do i = 1 to WarningCount
call writeln('FWCLog', 'Warning: 'Warning.i)
end
do i = 1 to InformationCount
call writeln('FWCLog', 'Information: 'Information.i)
end
if (ErrorCount > 0) | (WarningCount > 0) then do
if PrefsFile ~= 'Default' then do
if (exists(PrefsFile)) & (length(ReadFile(PrefsFile)) > 2) then do
call writeln('FWCLog', '0a'x||' -- 'PrefsFile' -- ')
if open('DataFile', PrefsFile) then do
do until eof('DataFile')
if ~eof('DataFile') then do
Ln = ReadLn('DataFile')
call writeln('FWCLog', Ln)
end
end
call close('DataFile')
end
end
end
if ErrorCount > 0 then ErrorType = Critical$
else ErrorType = Noncritical$
FileMsg = ErrorType' ... 'See$' 'Storage'FWCLog.txt 'ForDetails$'.'||'0a'x||ForwardLog$': Ron Goertz <goertz@earthlink.net>'||'0a'x||Unable$
Conbgui = ErrorType' ... 'SeeShell$'.'||'0a'x||ForwardContent$||'0a'x||'Ron Goertz <goertz@earthlink.net>'||'0a'x||Unable$
ConCon = ErrorType' ... 'SeeOutput$'.'||'0a'x||ForwardContent$||'0a'x||'Ron Goertz <goertz@earthlink.net>'||'0a'x||Unable$
if (OutType == 'File') & (ClassAct == 1) then call CASimpleReq('FWCalendar 'Notice$, FileMsg)
if (OutType == 'File') & (bguiopen == 1) then call bguireq('1B'x||'c'FileMsg,'*'OK$,'FWCalendar 'Notice$,,AppScreen)
if (OutType == 'File') & (bguiopen == 0) & (ClassAct == 0) then do
call open('CON', 'CON:10/10/500/300/FWCalendar notice/WAIT/CLOSE')
call writeln('CON', FileMsg)
call close('CON')
end
if (OutType == 'CON') & (ClassAct == 1) then call CASimpleReq('FWCalendar 'Notice$, Conbgui)
if (OutType == 'CON') & (bguiopen == 1) then call bguireq('1B'x||'c'Conbgui,'*'OK$,'FWCalendar 'Notice$,,AppScreen)
if (OutType == 'CON') & (bguiopen == 0) & (ClassAct == 0) then call Writeln('FWCLog', '0a'x||ConCon)
end
end
if (ErrorCount == 0) & (WarningCount == 0) then do
if LogOpen == 1 then call writeln('FWCLog', 'No errors.')
end
address command 'delete >NIL: 'Storage'FWC'App'Temp.txt quiet'
address command 'delete >NIL: 'Storage'FWCTemp quiet'
call close('FWCLog')
if bguiopen = 1 then call bguiclose()
exit
/**/
/***//*** ConvertChangesFile (CCF) ***/
ConvertChangesFile:
/* Determine current prefs file */
if length(readfile(ScriptDir'FWC.dat')) < 2 then return
CCF_DataFile = ReadFile(ScriptDir'FWC.dat')
if CCF_DataFile ~= '' then do
call openv('CCF_DataFile')
CCF_DataVersion = readvln('CCF_DataFile')
PrefsFile = readvln('CCF_DataFile')
PrefsFile = strip(substr(PrefsFile, pos('=', PrefsFile) + 1),," '")
CCF_Data = readvch('CCF_DataFile', 65535)
call closev('CCF_DataFile')
call WriteFile('ENV:FWCalendar', PrefsFile, 'B')
if PrefsFile ~= 'Default' then do
/* Move translation strings to separate file */
if open('DataFile', PrefsFile) then do
call openv('CCF_TranslationFile')
call openv('CCF_DataFile')
do until eof('DataFile')
CCF_Ln = ReadLn('DataFile')
CCF_Var = upper(word(CCF_Ln, 1))
if right(CCF_Var, 1) == '$' then call writevln('CCF_TranslationFile', compress(CCF_Ln, ':'))
else call writevln('CCF_DataFile', CCF_Ln)
end
call closev('CCF_DataFile')
call closev('CCF_TranslationFile')
call close('DataFile')
if CCF_TranslationFile ~= '' then do
if open('DataFile', ScriptDir'FWCTranslations.txt', 'W') then do
call writeln('DataFile', '/* FWC Translation file v4.x */')
call writeln('DataFile', CCF_TranslationFile)
call close('DataFile')
interpret ReadFile(ScriptDir'FWCTranslations.txt')
end
else call AddMsg('W', 'Unable to create translation file.')
end
if open('DataFile', PrefsFile, 'W') then do
call writeln('DataFile', CCF_DataFile)
call close('DataFile')
end
else do
call AddMsg('E', 'Unable to re-create preference file.')
call Cleanup
end
end
end
end
address command 'delete >NIL: 'ScriptDir'FWC.dat'
return
/**/
/***//*** ConvertJ (CJ) ***/
/* Routine to convert from 'J' & 'F' to normal dates obtained from the Sky & Telescope */
/* web site. The basic program from which the following was derived originally */
/* appeared in Astronomical Computing, Sky & Telescope, May, 1984 */
ConvertJ:
parse arg CJ_F, CJ_J
CJ_F = CJ_F + 0.5
if CJ_F >= 1 then do
CJ_F = CJ_F - 1
CJ_J = CJ_J + 1
end
CJ_A1 = trunc((CJ_J / 36524.25) - 51.12264)
CJ_A = CJ_J + 1 + CJ_A1 - trunc(CJ_A1 / 4)
CJ_B = CJ_A + 1524
CJ_C = trunc((CJ_B / 365.25) - 0.3343)
CJ_D = trunc(365.25 * CJ_C)
CJ_E = trunc((CJ_B - CJ_D) / 30.61)
CJ_D = CJ_B - CJ_D - trunc(30.61 * CJ_E) + CJ_F
CJ_M = CJ_E - 1
CJ_Y = CJ_C - 4716
IF CJ_E > 13.5 then CJ_M = CJ_M - 12
IF CJ_M < 2.5 then CJ_Y = CJ_Y + 1
CJ_Day = trunc(CJ_D)
return right(CJ_Y, 4, '0')' 'right(CJ_M, 2, '0')' 'right(CJ_Day, 2, '0')' 'CJ_D - CJ_Day
/**/
/***//*** ControlMX (CM) ***/
ControlMX:
parse arg CM_SourceGrp, CM_SourcePosn
DSR_Sel.CM_SourceGrp = CM_SourcePosn
if DSR_Sel.CM_SourceGrp == DSR_PSel.CM_SourceGrp then do
if ClassAct == 1 then call ToPIPE('CA', 'id 'Gad.CM_SourceGrp.CM_SourcePosn' s=1 page='ClickTab' refresh')
return
end
CM_PSelect = DSR_PSel.CM_SourceGrp
CM_Select = DSR_Sel.CM_SourceGrp
GadSel.CM_SourceGrp.CM_PSelect = 0
GadSel.CM_SourceGrp.CM_Select = 1
if ClassAct == 1 then call ToPIPE('CA', 'id 'Gad.CM_SourceGrp.CM_PSelect' s=0 page='ClickTab' refresh')
do CM_DestGrp = 0 to GroupCount
/* nop for source group */
if CM_DestGrp == CM_SourceGrp then iterate
if CM_PSelect ~= 0 then do
/* Update enables in disable string */
DSR_Dis.CM_DestGrp = overlay(substr(DSR_Dis.CM_DestGrp, CM_PSelect + 1, 1) - 1, DSR_Dis.CM_DestGrp, CM_PSelect + 1)
do CM_i = 1 to MXPairCount
if (substr(word(MXPair.CM_i, 1), CM_SourceGrp + 1, 1) == '1') & (substr(word(MXPair.CM_i, 1), CM_DestGrp + 1, 1) == '1') then do
call CM_SetDisables(CM_PSelect, word(MXPair.CM_i, 2), word(MXPair.CM_i, 3), 'Enable')
call CM_SetDisables(CM_PSelect, word(MXPair.CM_i, 3), word(MXPair.CM_i, 2), 'Enable')
end
end
end
if CM_Select ~= 0 then do
/* Update disables in disable string */
DSR_Dis.CM_DestGrp = overlay(substr(DSR_Dis.CM_DestGrp, CM_Select + 1, 1) + 1, DSR_Dis.CM_DestGrp, CM_Select + 1)
do CM_i = 1 to MXPairCount
if (substr(word(MXPair.CM_i, 1), CM_SourceGrp + 1, 1) == '1') & (substr(word(MXPair.CM_i, 1), CM_DestGrp + 1, 1) == '1') then do
call CM_SetDisables(CM_Select, word(MXPair.CM_i, 2), word(MXPair.CM_i, 3), 'Disable')
call CM_SetDisables(CM_Select, word(MXPair.CM_i, 3), word(MXPair.CM_i, 2), 'Disable')
end
end
end
end
/* Update previous select posn */
DSR_PSel.CM_SourceGrp = DSR_Sel.CM_SourceGrp
do CM_Grp = 0 to GroupCount
do forever
/* Determine differences between previous- and current-disable strings */
/* -1 means strings are the same */
comp = compare(DSR_Dis.CM_Grp, DSR_PDis.CM_Grp) - 1
if comp > -1 then do
/* Make change to GUI */
GadDis.CM_Grp.comp = substr(DSR_Dis.CM_Grp, comp + 1, 1)
if ClassAct == 1 then do
if datatype(Gad.CM_Grp.comp) == 'NUM' then call ToPIPE('CA', 'id 'Gad.CM_Grp.comp' dis='substr(DSR_Dis.CM_Grp, comp + 1, 1)' page='ClickTab' refresh')
end
else do
CM_Action = sign(substr(DSR_Dis.CM_Grp, comp + 1, 1))
interpret 'call bguiset('grp.CM_Grp',winID,'Action.CM_Action',comp)'
end
/* Update previous-disable string */
DSR_PDis.CM_Grp = overlay(substr(DSR_Dis.CM_Grp, comp + 1, 1), DSR_PDis.CM_Grp, comp + 1)
end
else leave
end
end
return
/***//*** CM_SetDisables (CMSD) ***/
CM_SetDisables:
parse arg CMSD_KeyPosn, CMSD_MX1, CMSD_MX2, CMSD_Action
if upper(CMSD_Action) == 'ENABLE' then CMSD_Sign = -1
else CMSD_Sign = 1
if substr(CMSD_MX1, CMSD_KeyPosn, 1) == 1 then do
CMSD_Posn = 0
do CMSD_j = 1 to length(CMSD_MX2) - length(compress(CMSD_MX2, '1'))
CMSD_Posn = pos('1', CMSD_MX2, CMSD_Posn + 1)
/* Enable/Disable MX pairs */
DSR_Dis.CM_DestGrp = overlay(substr(DSR_Dis.CM_DestGrp, CMSD_Posn + 1, 1) + CMSD_Sign, DSR_Dis.CM_DestGrp, CMSD_Posn + 1)
end
end
return
/**/
/**/
/***//*** DateInfo (PROCEDURE) ***/
DateInfo: PROCEDURE
/* DateInfo('I', '19780101', 'S') = 2443510 */
/* Date('I', '19780101', 'S') = 0 */
/* Option 'C' returns days since Jan 1, xx00 */
parse arg Option, Date, Format
if Option == '' then Option = 'N'
if Date == '' then do
Date = Date('S')
Format = 'S'
end
Option = upper(left(Option, 1))
Format = upper(left(Format, 1))
if (Format == 'I') | (Format = '') then do
Format = 'I'
/* Routine to convert from a serial date to year/month/day obtained from the */
/* Sky & Telescope web site. The basic program from which the following was */
/* derived originally appeared in Astronomical Computing, Sky & Telescope,May, 1984 */
A1 = trunc((Date / 36524.25) - 51.12264)
A = Date + 1 + A1 - trunc(A1 / 4)
B = A + 1524
C = trunc((B / 365.25) - 0.3343)
D = trunc(365.25 * C)
E = trunc((B - D) / 30.61)
D = B - D - trunc(30.61 * E)
Month = E - 1
Year = C - 4716
IF E > 13.5 then Month = Month - 12
IF Month < 2.5 then Year = Year + 1
Day = trunc(D)
J = Date
end
else do
Year = left(Date, 4) - 0
Month = substr(Date, 5, 2) - 0
Day = right(Date, 2) - 0
/* The following two lines are modified from PerpetualCalendar.bas that */
/* appeared in Astronomical Computing, Sky & Telescope, July, 1985 */
Temp = 0; if Month <= 2 then Temp = -1
J = 367*Year-trunc(7*(Year+trunc((Month + 9)/12))/4)+trunc(275*Month/9)+1721031-trunc(3*(trunc((Year+Temp)/100)+1)/4) + Day - 2
end
select
when Option == 'B' then do
return J - 1721060
end
when Option == 'C' then do
return J + 2 - DateInfo('I', left(right(Year, 4, '0'), 2)'000101', 'S')
end
when (Option == 'D') | (Option == 'J') then do
DayCount = 0
MonthLength.1 = 31
MonthLength.2 = 28
MonthLength.3 = 31
MonthLength.4 = 30
MonthLength.5 = 31
MonthLength.6 = 30
MonthLength.7 = 31
MonthLength.8 = 31
MonthLength.9 = 30
MonthLength.10 = 31
MonthLength.11 = 30
MonthLength.12 = 31
if (Year//4 == 0 & Year//100 > 0) | Year//400 == 0 Then MonthLength.2 = 29
do I = (Month - 1) to 1 by -1
DayCount = DayCount + MonthLength.I
end
if Option == 'D' then return DayCount + Day
else return right(Year, 2)''right(DayCount + Day, 3, '0')
end
when Option == 'E' then do
return right(Day, 2, '0')'/'right(Month, 2, '0')'/'right(Year, 2, '0')
end
when Option == 'I' then return J
when (Option == 'M') | (Option == 'N') then do
Select
when Month == 1 then Month = 'January'
when Month == 2 then Month = 'February'
when Month == 3 then Month = 'March'
when Month == 4 then Month = 'April'
when Month == 5 then Month = 'May'
when Month == 6 then Month = 'June'
when Month == 7 then Month = 'July'
when Month == 8 then Month = 'August'
when Month == 9 then Month = 'September'
when Month == 10 then Month = 'October'
when Month == 11 then Month = 'November'
when Month == 12 then Month = 'December'
end
if Option == 'M' then return Month
else return right(Day, 2, '0')' 'left(Month, 3)' 'Year
end
when Option == 'O' then return right(Year, 2, '0')'/'right(Month, 2, '0')'/'right(Day, 2, '0')
when Option == 'S' then return right(Year, 4, '0')''right(Month, 2, '0')''right(Day, 2, '0')
when Option == 'U' then return right(Month, 2, '0')'/'right(Day, 2, '0')'/'right(Year, 2, '0')
when Option == 'W' then do
J = J + 1
Weekday = J - 7 * trunc(J / 7)
Select
when Weekday == 0 then return 'Sunday'
when Weekday == 1 then return 'Monday'
when Weekday == 2 then return 'Tuesday'
when Weekday == 3 then return 'Wednesday'
when Weekday == 4 then return 'Thursday'
when Weekday == 5 then return 'Friday'
when Weekday == 6 then return 'Saturday'
end
end
otherwise return 0
end
/**/
/***//*** DetermineDate (DD) ***/
DetermineDate:
parse arg DD_Month, DD_Day, DD_Year
if left(DD_Day, 2) == 32 then do
if length(DD_Day) == 2 then DD_Day = MonthLength.DD_Month
else DD_Day = MonthLength.DD_Month''right(DD_Day, 1)
end
DD_DateString = DD_Year''right(DD_Month, 2, '0')''right(strip(DD_Day, 'T', 'PN'), 2, '0')
DD_Weekday = DateInfo('W', DD_DateString, 'S')
if (right(DD_Day, 1) == 'N') & (DD_Weekday == 'Saturday') then do
DD_NewDay = DateInfo('S', (DateInfo('I', DD_DateString, 'S') + 2), 'I')
DD_Month = substr(DD_NewDay, 5, 2) - 0
DD_Day = substr(DD_NewDay, 7, 2) - 0
end
else if (right(DD_Day, 1) == 'P') & (DD_Weekday == 'Saturday') then do
DD_NewDay = DateInfo('S', (DateInfo('I', DD_DateString, 'S') - 1), 'I')
DD_Month = substr(DD_NewDay, 5, 2) - 0
DD_Day = substr(DD_NewDay, 7, 2) - 0
end
else if (right(DD_Day, 1) == 'N') & (DD_Weekday == 'Sunday') then do
DD_NewDay = DateInfo('S', (DateInfo('I', DD_DateString, 'S') + 1), 'I')
DD_Month = substr(DD_NewDay, 5, 2) - 0
DD_Day = substr(DD_NewDay, 7, 2) - 0
end
else if (right(DD_Day, 1) == 'P') & (DD_Weekday == 'Sunday') then do
DD_NewDay = DateInfo('S', (DateInfo('I', DD_DateString, 'S') - 2), 'I')
DD_Month = substr(DD_NewDay, 5, 2) - 0
DD_Day = substr(DD_NewDay, 7, 2) - 0
end
DD_Day = strip(DD_Day, 'T', 'PN')
return DD_Month' 'DD_Day
/**/
/***//*** DetermineHost () ***/
DetermineHost:
owner = ReadFile('ENV:Owner')
if (pos('FINALWRITER', CurrentDir) > 0) | (left(CallHost, 6) == 'FINALW') then do
App = 'FW'
AppName = 'FINALWRITER'
if CallHost == 'REXX' then HostPort = substr(PortList, pos('FINALW.', PortList), 8)
else HostPort = CallHost
address value HostPort
if owner == 'rgoertz' then do
if CallHost == 'REXX' then CLEARDOC FORCE
else do
CLEARDOC
if result == 1 then exit
end
end
else do
CLEARDOC
if result == 1 then exit
end
GETDOCITEMPREFS Decimal; DecimalFormat = result
DOCITEMPREFS Decimal Period
end
else if (pos('PAGESTREAM', CurrentDir) > 0) | (CallHost == 'PAGESTREAM') then do
App = 'PGS'
AppName = 'PAGESTREAM'
HostPort = 'PAGESTREAM'
address value HostPort
end
else do
call AddMsg('E', 'Unable to determine host!')
call AddMsg('E', 'Make sure FWCalendar is called from Final Writer or PageStream.')
call Cleanup
end
NameAndVersion = getclip('FWC'App'VersionInfo.txt')
if NameAndVersion == '' then do
address command 'list >PIPE:FWC 'AppName'#? lformat %N'
ListOutput = ReadFile('PIPE:FWC')
call openv('ListOutput')
do while ~eofv('ListOutput')
PgmName = readvln('ListOutput')
if pos('.', PgmName) == 0 then leave
end
call closev('ListOutput')
PgmVersion = PgmVer(PgmName)
NameAndVersion = PgmName' 'PgmVersion
if PgmVersion == 'not' then do
if App == 'FW' then do
call open('Temp', CurrentDir''PgmName)
/* Desired string at 325365 for v 5.06 */
/* Desired string at 333771 for FW97 */
FileOffset = 325300
call seek('Temp', FileOffset, 'B')
do until (EndPos ~= 0) | (PrevOffset = FileOffset)
PrevOffset = FileOffset
Chunk = readch('Temp', 10000)
EndPos = pos('Created', Chunk)
if EndPos == 0 then FileOffset = seek('Temp', -100, 'C')
end
if EndPos ~= 0 then do
StartPos = lastpos('Final', Chunk, EndPos)
EndPos = pos('00'x||'00'x, Chunk, StartPos)
NameAndVersion = substr(Chunk, StartPos, EndPos - StartPos - 1)
end
else do
FileOffset = 0
call seek('Temp', FileOffset, 'B')
do until (EndPos ~= 0) | (PrevOffset = FileOffset)
PrevOffset = FileOffset
Chunk = readch('Temp', 10000)
EndPos = pos('FinalWriter 97', Chunk)
if EndPos == 0 then FileOffset = seek('Temp', -100, 'C')
end
if EndPos ~= 0 then NameAndVersion = 'FinalWriter 97'
else NameAndVersion = 'Final Writer - version unknown'
end
call close('Temp')
end
else if App == 'PGS' then do
NameAndVersion = PgmName" - can't find version info"
end
end
call setclip('FWC'App'VersionInfo.txt', NameAndVersion)
end
else do
PgmName = word(NameAndVersion, 1)
PgmVersion = subword(NameAndVersion, 2)
end
AppScreen = ''
PubScreenApps = 'FrontPubScreen Publican MagicPubName'
do i = 1 to words(PubScreenApps)
interpret 'address command "'word(PubScreenApps, i)' >PIPE:FWC"'
if RC > 0 then iterate
AppScreen = readfile('PIPE:FWC')
if AppScreen ~= '' then leave
end
return HostPort
/**/
/***//*** DoOptions (DO) ***/
DoOptions:
if (DayType == 'Extended') & (BackgroundColor == '<'Clear$'>') then DO_PrintColor = Color.Extended
else if (DayType == 'Extended') & (BackgroundColor ~= '<'Clear$'>') then DO_PrintColor = AltColor.Extended
/***//* DoJulian & DoJulianLeft */
if (DoJulian ~= '') | (DoJulianLeft ~= '') then do
DO_JDay = right(DateInfo('J', JulianDay, 'I'), 3)
if (Day <= 0) & (PrevMonth = 12) then DO_JDayLeft = right(365 + PrevLeapYear - DO_JDay, 3, '0')
else DO_JDayLeft = right(365 + LeapYear - DO_JDay, 3, '0')
if (DayType ~= 'Extended') & (BackgroundColor == '<'Clear$'>') then DO_PrintColor = Color.Julian
else if (DayType ~= 'Extended') & (BackgroundColor ~= '<'Clear$'>') then DO_PrintColor = AltColor.Julian
if DoJulian ~= '' then do
DO_Text2Print = Text.Julian''DO_JDay
if DoJulianLeft == DoJulian then DO_Text2Print = DO_Text2Print'/'DO_JDayLeft
JID.Day = PrintOption(DoJulian)
end
if (DoJulianLeft ~= '') & (DoJulianLeft ~= DoJulian) then do
DO_Text2Print = DO_JDayLeft
JIDL.Day = PrintOption(DoJulianLeft)
end
end
/**/
/***//* DoSunrise & DoSunset */
if (DoSunRise ~= '') | (DoSunSet ~= '') then do
SRSS$ = GetSRSS(JulianDay)
if DoSunRise ~= '' then do
if (DayType ~= 'Extended') & (BackgroundColor == '<'Clear$'>') then DO_PrintColor = Color.Sunrise
else if (DayType ~= 'Extended') & (BackgroundColor ~= '<'Clear$'>') then DO_PrintColor = AltColor.Sunrise
DO_Text2Print = Text.Sunrise''word(SRSS$, 1)
if DoSunSet == DoSunRise then DO_Text2Print = DO_Text2Print'/'word(SRSS$, 3)
SRID.Day = PrintOption(DoSunRise)
end
if (DoSunSet ~= '') & (DoSunSet ~= DoSunRise) then do
if (DayType ~= 'Extended') & (BackgroundColor == '<'Clear$'>') then DO_PrintColor = Color.Sunset
else if (DayType ~= 'Extended') & (BackgroundColor ~= '<'Clear$'>') then DO_PrintColor = AltColor.Sunset
DO_Text2Print = Text.Sunset''word(SRSS$, 3)
SSID.Day = PrintOption(DoSunSet)
end
end
/**/
/***//* DoWeekNumber */
if (DoWeekNumber ~= '') & (CurrentColumn = 0) then do
if (DayType ~= 'Extended') & (BackgroundColor == '<'Clear$'>') then DO_PrintColor = Color.WeekNumber
else if (DayType ~= 'Extended') & (BackgroundColor ~= '<'Clear$'>') then DO_PrintColor = AltColor.WeekNumber
DO_WN = trunc((right(DateInfo('J', JulianDay, 'I'), 3) - YearOffset - 1)/7 + 1)
DO_Text2Print = Text.WeekNumber''DO_WN
WNID.Day = PrintOption(DoWeekNumber)
end
/**/
/***//* DoImages */
if DoImages == 1 then do
if Image.Month.Day ~= '' then do
ImageNumber = Image.Month.Day
ImageDX = ImageDX.ImageNumber
ImageDY = ImageDY.ImageNumber
if ImageType.ImageNumber == '' then do
DO_Cmd = Storage''GfxApp' >PIPE:FWC '
DO_InsertPos = pos('%s', GfxCmd)
DO_Cmd = DO_Cmd''left(GfxCmd, DO_InsertPos - 1)''ImageFile.ImageNumber''substr(GfxCmd, DO_InsertPos + 2)
address command DO_Cmd
DO_Template = GfxTemplate
DO_InfoLine = ReadFile('PIPE:FWC')
if DO_InfoLine ~= '' then do
interpret "parse var DO_InfoLine "DO_Template
DO_ImageType = upper(strip(ImgDT))
DO_Width = strip(ImgWidth)
DO_Height = strip(ImgHeight)
if (datatype(DO_ImageType) ~= 'CHAR') | (datatype(DO_Width) ~= 'NUM') | (datatype(DO_Height) ~= 'NUM') then do
call AddMsg('W', DO_InfoLine)
Image.Month.Day = ''
end
else do
ImageType.ImageNumber = DO_ImageType
if DO_ImageType ~= 'POST' then do
ImageWidth.ImageNumber = DO_Width / 72
ImageHeight.ImageNumber = DO_Height / 72
if (ImageWidth.ImageNumber > (BoxWidth * MaxImgWidth)) | (ImageHeight.ImageNumber > (BHeight * MaxImgHeight)) then do
EnlFactor = max(ImageWidth.ImageNumber / (BoxWidth * MaxImgWidth), ImageHeight.ImageNumber / (BHeight * MaxImgHeight))
ImageWidth.ImageNumber = ImageWidth.ImageNumber / EnlFactor
ImageHeight.ImageNumber = ImageHeight.ImageNumber / EnlFactor
end
end
end
end
end
if ImageType.ImageNumber ~= '' then do
if App == 'FW' then do
if ImageWidth.ImageNumber == 0 then do
INSERTIMAGE ImageFile.ImageNumber POSITION 1 '-1' '-1' '-1' '-1'
ImageID.Day = result
GETOBJECTCOORDS ImageID.Day
parse var result . . . ImageWidth.ImageNumber ImageHeight.ImageNumber
if (ImageWidth.ImageNumber > (BoxWidth * MaxImgWidth)) | (ImageHeight.ImageNumber > (BHeight * MaxImgHeight)) then do
EnlFactor = max(ImageWidth.ImageNumber / (BoxWidth * MaxImgWidth), ImageHeight.ImageNumber / (BHeight * MaxImgHeight))
ImageWidth.ImageNumber = ImageWidth.ImageNumber / EnlFactor
ImageHeight.ImageNumber = ImageHeight.ImageNumber / EnlFactor
end
DELETEOBJECT ImageID.Day
end
Image.Left = BoxLeft + (BoxWidth - ImageWidth.ImageNumber)/2 + ImageDX
Image.Top = BoxTop + (BHeight - ImageHeight.ImageNumber)/2 + ImageDY
INSERTIMAGE ImageFile.ImageNumber POSITION 1 Image.Left Image.Top ImageWidth.ImageNumber ImageHeight.ImageNumber
ImageID.Day = result
OBJECTTOBACK ImageID.Day
end
else if App == 'PGS' then do
DO_ImgType = ImageType.ImageNumber
if PGSFilter.DO_ImgType == '' then PGSFilter.DO_ImgType = DO_ImgType
if ImageWidth.ImageNumber == 0 then do
PLACEGRAPHIC FILE ImageFile.ImageNumber FILTER PGSFilter.DO_ImgType WINDOW winName
ImageID.Day = result
if ImageType.ImageNumber == 'POST' then GETDRAWING POSITION Image OBJECTID ImageID.Day WINDOW winName
else GETPICTURE POSITION Image OBJECTID ImageID.Day WINDOW winName
DELETEOBJECT OBJECTID ImageID.Day WINDOW winName
ImageWidth.ImageNumber = Image.Right - Image.Left
ImageHeight.ImageNumber = Image.Bottom - Image.Top
if (ImageWidth.ImageNumber > (BoxWidth * MaxImgWidth)) | (ImageHeight.ImageNumber > (BHeight * MaxImgHeight)) then do
EnlFactor = max(ImageWidth.ImageNumber / (BoxWidth * MaxImgWidth), ImageHeight.ImageNumber / (BHeight * MaxImgHeight))
ImageWidth.ImageNumber = ImageWidth.ImageNumber / EnlFactor
ImageHeight.ImageNumber = ImageHeight.ImageNumber / EnlFactor
end
end
Image.Left = BoxLeft + (BoxWidth - ImageWidth.ImageNumber)/2 + ImageDX
Image.Top = BoxTop + (BHeight - ImageHeight.ImageNumber)/2 + ImageDY
PLACEGRAPHIC FILE ImageFile.ImageNumber FILTER PGSFilter.DO_ImgType AT Image.Left Image.Top WINDOW winName
ImageID.Day = result
if ImageType.ImageNumber == 'POST' then EDITDRAWING POSITION Image.Left Image.Top (Image.Left + ImageWidth.ImageNumber) (Image.Top + ImageHeight.ImageNumber) OBJECTID ImageID.Day WINDOW winName
else EDITPICTURE POSITION Image.Left Image.Top (Image.Left + ImageWidth.ImageNumber) (Image.Top + ImageHeight.ImageNumber) OBJECTID ImageID.Day WINDOW winName
SENDTOBACK OBJECTID ImageID.Day WINDOW winName
end
end
end
end
/**/
/***//* DoPhases */
if Day < 1 then do
DO_PrintColor = Color.Extended
DO_MoonMonth = PrevMonth
DO_MoonYear = PrevYear
end
else if Day > MonthLength.Month then do
DO_PrintColor = Color.Extended
DO_MoonMonth = NextMonth
DO_MoonYear = NextYear
end
else do
DO_PrintColor = Color.Moon
DO_MoonMonth = Month
DO_MoonYear = EnteredYear
end
if (DoPhases ~= '') & (MoonPhase.DO_MoonYear.DO_MoonMonth.PrintDay ~= '') then do
select
when right(DoPhases, 1) == 'L' then DO_MoonLeft = BoxLeft + (MoonRadius * 1.2)
when right(DoPhases, 1) == 'C' then DO_MoonLeft = BoxLeft + BoxWidth / 2
when right(DoPhases, 1) == 'R' then DO_MoonLeft = BoxLeft + BoxWidth - (MoonRadius * 1.2)
end
if left(DoPhases, 1) == 'T' then DO_DX = MoonRadius * 1.2
else if left(DoPhases, 1) == 'B' then DO_DX = BHeight - (MoonRadius * 1.2)
MoonID.Day = DrawMoon(MoonPhase.DO_MoonYear.DO_MoonMonth.PrintDay, DO_MoonLeft, BoxTop + DO_DX, DO_PrintColor)
if left(DoPhases, 1) == 'T' then MoonID.Day = 0
end
/**/
/***//* DoHistory */
if DoHistory ~= 0 then do
DO_Start = pos('|'||PrintDay, RandomFile)
if DO_Start ~= 0 then do
DO_End = pos('|'||'0a'x, RandomFile, DO_Start)
if DO_End == 0 then DO_End = length(RandomFile)
DO_RandomFile = substr(RandomFile, DO_Start, DO_End - DO_Start - 1)
RandomCount = length(DO_RandomFile) - length(compress(DO_RandomFile, '|'))
if RandomCount == 1 then RandomLine = 1
else RandomLine = trunc(randu(time(s)*date('I')) * RandomCount) + 1
call openv('DO_RandomFile')
if RandomLine > 1 then call readvln('DO_RandomFile', RandomLine - 1)
call PrintHighlight(strip(substr(readvln('DO_RandomFile'), 4)), 'History')
call closev('DO_RandomFile')
end
end
/**/
/***//* DoRandom */
if DoRandom ~= 0 then do
if RandomCount >= Monthlength.Month then do
do until pos('|'RandomLine'|', UsedRandoms) == 0
RandomLine = trunc(randu(time(s)*date('I')) * RandomCount) + 1
end
UsedRandoms = UsedRandoms'|'RandomLine'|'
end
else RandomLine = trunc(randu(time(s)*date('I')) * RandomCount) + 1
call seekv('RandomFile', 0, 'B')
if RandomLine > 1 then call readvln('RandomFile', RandomLine - 1)
call PrintHighlight(substr(readvln('RandomFile'), 2), 'Random')
end
/**/
return
/**/
/***//*** DoSetupReq_BGUI () ***/
DoSetupReq_BGUI:
grp.0 = 'obj.bottomleft_'
grp.1 = 'obj.bottomcenter_'
grp.2 = 'obj.bottomright_'
grp.3 = 'obj.topcenter_'
grp.4 = 'obj.topright_'
Action.0 = 'MX_EnableButton'
Action.1 = 'MX_DisableButton'
DoBothS = ''
DoBothJ = ''
UCMN = upper(CurrentMiscName)
if (UCMN == 'GFXAPPPATH') | (UCMN == 'SUNCALCPATH') | (UCMN == 'GFXAPP') then VarReqGad = 1
else VarReqGad = 0
if (PrefsName == 'Default') & (PrefsFile ~= 'Default') then DisplayName = PrefsFile
else DisplayName = PrefsName
do DSR_Posn = 1 + (PhaseLib ~= 1) to 5 + 3 * exists(Storage'suncalc')
interpret 'DoVariable = "Do'Do.DSR_Posn'"'
if value(DoVariable) == 0 then interpret DoVariable " = ''"
if value(DoVariable) ~= '' then do
interpret DoVariable' = right(value(DoVariable), 2, "B")'
DSR_Grp = translate(left(value(DoVariable), 1), '02', 'BT') + translate(right(value(DoVariable), 1), '012', 'LCR')
GadSel.DSR_Grp.DSR_Posn = 1
DSR_Sel.DSR_Grp = DSR_Posn
end
end
do DSR_Grp = 0 to GroupCount
if (GadSel.DSR_Grp.SunsetPosn == GadSel.DSR_Grp.SunrisePosn) & (GadSel.DSR_Grp.SunsetPosn == 1) then do
GadSel.DSR_Grp.SunsetPosn = 0
GadSel.DSR_Grp.SunrisePosn = 0
GadSel.DSR_Grp.BothSPosn = 1
DSR_Sel.DSR_Grp = BothSPosn
end
else if (GadSel.DSR_Grp.JulianPosn == GadSel.DSR_Grp.JulianLeftPosn) & (GadSel.DSR_Grp.JulianPosn == 1) then do
GadSel.DSR_Grp.JulianPosn = 0
GadSel.DSR_Grp.JulianLeftPosn = 0
GadSel.DSR_Grp.BothJPosn = 1
DSR_Sel.DSR_Grp = BothJPosn
end
end
call bguilist('monthlist_',January$,February$,March$,April$,May$,June$,July$,August$,September$,October$,November$,December$)
call bguilist('mxopts_',None$,Phases$,Weeknumber$,Julian$,JulLeft$,JulJulLeft$,Sunrise$,Sunset$,RiseSet$)
call bguilist('mxopts2_',None$,Phases$,Weeknumber$,Julian$,JulLeft$,JulJulLeft$,Sunrise$,Sunset$,RiseSet$,History$,Random$)
if App == 'FW' then do
call bguilist('calendartypelist_',SingleMonth$,WholeYear$)
MonthYearGads = bguihgroup(,
bguicycle('monthchoice_',,'monthlist_','P')bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
bguistring('yearchoice_',,Year,5)bguilayout(LGO_FixMinHeight, 1))
end
else do
call bguilist('calendartypelist_',SingleMonth$,MultiMonth$,WholeYear$)
MonthYearGads = bguihgroup(,
bguicycle('monthchoice_',,'monthlist_','P')bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
bguicycle('endmonthchoice_',,'monthlist_','P')bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
bguistring('yearchoice_',,Year,5)bguilayout(LGO_FixMinHeight, 1))
end
/***//*** GUI Description ***/
if UpdateBusy(Req, 1) == -1 then call Cleanup
g=bguivgroup(,
bguiinfo('dummy_',,esc||'c'DisplayName)bguilayout(LGO_FixMinHeight, 1)||,
bguimx('mainswitcher_',,bguilist('mainpnames_',OptLayout$,Variables$,Top$,Bottom$),'T')bguilayout(LGO_FixMinHeight,1)||,
bguipages('mainpages_',,
bguivgroup(,
bguihgroup(,
bguivgroup(,
bguicheckbox('minicals_',MiniCals$, DoMiniCals)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
bguicheckbox('highlights_',Highlights$, DoHighlights)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
bguicheckbox('images_',Images$, DoImages)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
bguicheckbox('dateboxes_',BoxDates$, DoDateBox)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1),
)||,
bguivarspace(10)||,
bguivgroup(,
bguicheckbox('extended_',Extended$, DoExtended)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
bguicheckbox('toplong_',TopLong$, DoTopExtraWk)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
bguicheckbox('notebox_',NoteBox$, DoNoteBox)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1),
),
,-2,'F',Options$)||,
bguivgroup(,
bguihgroup(,
bguivarspace(40)||,
bguistring('topmargin_',,Margin.Top,8)bguilayout(LGO_FixMinHeight, 1)bguilayout(LGO_Weight,20)||,
bguivarspace(40),
)||,
bguihgroup(,
bguivarspace(20)||,
bguistring('leftmargin_',,Margin.Left,8)bguilayout(LGO_FixMinHeight, 1,LGO_Weight,20)||,
bguicycle('orientation_',,bguilist('orientlist_',Wide$,Tall$))bguilayout(LGO_FixMinHeight, 1,LGO_Weight,20)||,
bguistring('rightmargin_',,Margin.Right,8)bguilayout(LGO_FixMinHeight, 1,LGO_Weight,20)||,
bguivarspace(20),
)||,
bguihgroup(,
bguivarspace(40)||,
bguistring('bottommargin_',,Margin.Bottom,8)bguilayout(LGO_FixMinHeight, 1,LGO_Weight,20)||,
bguivarspace(40),
),
,-2,'F',OrientMarg$),
)||,
bguivgroup(,
bguihgroup(,
bguicycle('fontvar_',,'FontVarName','P')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight, 1)||,
bguistring('fontvalue_',,value(CurrentFontName),256)bguilayout(LGO_FixMinHeight,1)||,
bguiibutton('addfont_','B','P')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight, 1),
,-2,'F',Fonts$)||,
bguivgroup(,
bguihgroup(,
bguicycle('colorvar_',,'ColorVarName','P')bguilayout(LGO_FixMinHeight, 1)||,
bguicycle('colorlist_',,'ColorList','P')bguilayout(LGO_FixMinHeight, 1),
)||,
bguihgroup(,
bguivarspace(1)||,
bguicheckbox('matchcolors_',MatchColors$, DoMatchColors)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1),
)||,
bguihgroup(,
bguivarspace(1)||,
bguicheckbox('dailycolors_',DailyColors$, DoDailyColors)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1),
),
,-2,'F',Colors$)||,
bguivgroup(,
bguihgroup(,
bguivarspace(40)||,
bguibutton('sethighlights_',HighlightEd$)bguilayout(LGO_FixMinHeight, 1,LGO_Weight,20)||,
bguivarspace(40),
)||,
bguihgroup(,
bguicycle('currentvar_',,'MiscVarName','P')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight, 1)||,
bguistring('currentvalue_',,VarVal,256)bguilayout(LGO_FixMinHeight,1)||,
bguiibutton('addvar_','B','F')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight, 1),
),
,-2,'F',MiscVar$),
,-2)||,
bguihgroup(,
bguivarspace(40)||,
bguivgroup(,
bguimx('topcenter_',Top$||'0a'x||Center$,'mxopts_','R')bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1),
,-3,'F')||,
bguivgroup(,
bguimx('topright_',Top$||'0a'x||Right$,'mxopts_','R')bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1),
,-3,'F'),
)||,
bguihgroup(,
bguivgroup(,
bguimx('bottomleft_',Bottom$||'0a'x||Left$,'mxopts_','R')bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1),
,-3,'F')||,
bguivgroup(,
bguimx('bottomcenter_',Bottom$||'0a'x||Center$,'mxopts2_','R')bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1),
,-3,'F')||,
bguivgroup(,
bguimx('bottomright_',Bottom$||'0a'x||Right$,'mxopts_','R')bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1),
,-3,'F'),
),
)||,
MonthYearGads||,
bguihgroup(,
bguicycle('calendartype_',,'calendartypelist_','P')bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
bguibutton('go_',Go$)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
bguivarspace(2)||,
bguibutton('reset_',Reset$)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
bguibutton('load_',Load$)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
bguibutton('saveas_',SaveAs$)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
bguivarspace(2)||,
bguibutton('cancel_',Cancel$)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1),
),
,'-3','-3')
/**/
if UpdateBusy(Req, 1) == -1 then call Cleanup
winID=bguiwindow(VarGUITitle$,g,-1,-1,,AppScreen)
if App == 'FW' then nop
else if App == 'PGS' then do
FontGroup=bguivgroup(bguilistview('fontlistview_',,'FontList'))
if UpdateBusy(Req, 1) == -1 then call Cleanup
FontwinID=bguiwindow(SelectFont$':',FontGroup,20,50,,AppScreen)
end
do DSR_Grp = 0 to GroupCount
interpret 'call bguiset('grp.DSR_Grp',winID,MX_Active,DSR_Sel.DSR_Grp)'
call ControlMX(DSR_Grp, DSR_Sel.DSR_Grp)
if PhaseLib ~= 1 then interpret 'call bguiset('grp.DSR_Grp',winID,MX_DisableButton,1)'
if ~exists(Storage'suncalc') then interpret 'call bguiset('grp.DSR_Grp',winID,MX_DisableButton,6,MX_DisableButton,7,MX_DisableButton,8)'
end
if App == 'PGS' then call bguiset(obj.endmonthchoice_, winID, GA_Disabled, 1)
call bguiset(obj.addvar_, winID, GA_Disabled, ~VarReqGad)
call bguiset(obj.orientation_,winID,CYC_Active,OrientChoice)
call bguiset(obj.monthchoice_,winID,CYC_Active,CalMonth-1)
call bguiset(obj.colorlist_,winID,CYC_Active,max(0, MemberID(Value(CurrentColorName),'ColorList')))
CurrentColor = bguiget(obj.colorlist_, CYC_Active)
call bguiset(obj.currentvar_,,BT_Key,'09'x)
call bguiset(obj.currentvalue_,,BT_Key,'0d'x)
call bguiset(obj.images_,winID,GA_Disabled,~exists(Storage''GfxApp))
call bguiaddmap(obj.mainswitcher_,obj.mainpages_,MX_Active,PAGE_Active)
call bguiwintabcycleorder(winID,obj.topmargin_||obj.leftmargin_||obj.rightmargin_||obj.bottommargin_)
if DoExtended == 1 then do
call bguiset(obj.toplong_,winID, GA_Selected, 0, GA_Disabled, 1)
DoTopExtraWk = 0
call bguiset(obj.notebox_,winID, GA_Selected, 0, GA_Disabled, 1)
DoNoteBox = 0
end
if UpdateBusy(Req, 1) == -1 then call Cleanup
DSR_Success = bguiwinopen(winID)
if DSR_Success == 0 then bguierror(12)
call CloseBusy(Req)
/***//*** GUI Action Loop ***/
Done = 0
Reset = 0
do while 1
call bguiwinwaitevent(winID,'ID')
select
when (id == id.cancel_) | (id == id.winclose) then Reset = 2
/***//*** ResetGad ***/
when id == id.reset_ then do
Reset = 1
PrefsFile = 'Default'
call WriteFile('ENV:FWCalendar', PrefsFile, 'B')
end
/**/
/***//*** LoadGad ***/
when id == id.load_ then do
CurrentPrefs = PrefsFile
PrefsFile = bguifilereq(ScriptDir''"FWCalendar.prefs", SelectFile$':', winID,DOPATTERNS,'#?.(data|prefs)')
if PrefsFile == '' then PrefsFile = CurrentPrefs
else do
if exists(PrefsFile) then do
Reset = 1
call WriteFile('ENV:FWCalendar', PrefsFile, 'B')
end
else do
call bguireq(PrefsFile' 'CantFind$'...','*'OK$,'FWCalendar 'Notice$,winID)
PrefsFile = CurrentPrefs
end
end
end
/**/
/***//*** SaveAsGad ***/
when id == id.saveas_ then do
DSR_File = bguifilereq(ScriptDir'FWCalendar.prefs', SelectPrefs$)
if DSR_File ~= '' then do
PrefsFile = DSR_File
call WriteFile('ENV:FWCalendar', PrefsFile, 'B')
end
end
/**/
/***//*** MiniCalsGad ***/
when id == id.minicals_ then DoMiniCals = sign(bguiget(obj.minicals_, GA_Selected))
/**/
/***//*** HighlightsGad ***/
when id == id.highlights_ then DoHighlights = sign(bguiget(obj.highlights_, GA_Selected))
/**/
/***//*** ExtendedGad ***/
when id == id.extended_ then do
DoExtended = sign(bguiget(obj.extended_, GA_Selected))
if DoExtended == 1 then do
call bguiset(obj.toplong_,winID, GA_Selected, 0, GA_Disabled, 1)
DoTopExtraWk = sign(bguiget(obj.toplong_, GA_Selected))
call bguiset(obj.notebox_,winID, GA_Selected, 0, GA_Disabled, 1)
DoNoteBox = sign(bguiget(obj.notebox_, GA_Selected))
end
else do
call bguiset(obj.toplong_,winID, GA_Disabled, 0)
call bguiset(obj.notebox_,winID, GA_Disabled, 0)
end
end
/**/
/***//*** Checkbox & Margin Gads ***/
when id == id.toplong_ then DoTopExtraWk = sign(bguiget(obj.toplong_, GA_Selected))
when id == id.notebox_ then DoNoteBox = sign(bguiget(obj.notebox_, GA_Selected))
when id == id.dateboxes_ then DoDateBox = sign(bguiget(obj.dateboxes_, GA_Selected))
when id == id.images_ then DoImages = sign(bguiget(obj.images_, GA_Selected))
when id == id.matchcolors_ then DoMatchColors = sign(bguiget(obj.matchcolors_, GA_Selected))
when id == id.dailycolors_ then DoDailyColors = sign(bguiget(obj.dailycolors_, GA_Selected))
when id == id.topmargin_ then Margin.Top = bguiget(obj.topmargin_, STRINGA_TextVal)
when id == id.leftmargin_ then Margin.Left = bguiget(obj.leftmargin_, STRINGA_TextVal)
when id == id.rightmargin_ then Margin.Right = bguiget(obj.rightmargin_, STRINGA_TextVal)
when id == id.bottommargin_ then Margin.Bottom = bguiget(obj.bottommargin_, STRINGA_TextVal)
when id == id.orientation_ then do
if bguiget(obj.orientation_,CYC_Active) == 0 then Orientation = 'Wide'
else Orientation = 'Tall'
end
/**/
/***//*** FontValueGad ***/
when id == id.fontvalue_ then do
call bguireq('1b'x||"c"MustUse$,"*"OK$,'',winID)
call bguiset(obj.fontvalue_, winID,STRINGA_TextVal, value(CurrentFontName))
end
/**/
/***//*** AddFontGad ***/
when id == id.addfont_ then do
if App == 'FW' then do
FontFile = bguifilereq(CurrentDir'FWFonts/SWOLFonts/', SelectFont$':', winID,,'#?')
if FontFile ~= '' then call bguiset(obj.fontvalue_, winID, STRINGA_TextVal,FontFile)
end
else if App == 'PGS' then do
call bguiwinbusy(winID)
call bguiwinopen(FontwinID)
do while 1
call bguiwinwaitevent(FontwinID,'ID')
if id = id.winclose then leave
if id = id.fontlistview_ then do
call bguiset(obj.fontvalue_, winID, STRINGA_TextVal,bguiget(obj.fontlistview_, LISTV_LastClicked))
leave
end
end
call bguiwinclose(FontwinID)
call bguiwinready(winID)
end
end
/**/
/***//*** FontVarGad ***/
when id == id.fontvar_ then do
interpret CurrentFontName" = "QuoteIt(bguiget(obj.fontvalue_, STRINGA_TextVal))
CurrentFontName = value('FontVarName.'bguiget(obj.fontvar_, CYC_Active))
call bguiset(obj.fontvalue_,winID,STRINGA_TextVal,Value(CurrentFontName))
end
/**/
/***//*** AddVarGad ***/
when id == id.addvar_ then do
if (upper(CurrentMiscName) == 'GFXAPPPATH') | (upper(CurrentMiscName) == 'GFXAPP') then do
Value = bguifilereq(GfxAppPath, SelectApp$':', winID,,'#?')
if Value ~= '' then do
GPath = pathpart(Value)
GFile = filepart(Value)
if upper(CurrentMiscName) == 'GFXAPPPATH' then call bguiset(obj.currentvalue_, winID, STRINGA_TextVal,GPath)
else call bguiset(obj.currentvalue_, winID, STRINGA_TextVal,GFile)
interpret 'GfxAppPath = 'QuoteIt(GPath)
interpret 'GfxApp = 'QuoteIt(GFile)
if (exists(GfxAppPath''GfxApp)) & (~exists(Storage''GfxApp)) then do
address command 'copy 'GfxAppPath''GfxApp' 'Storage
call bguiset(obj.images_,winID,GA_Disabled,~exists(Storage''GfxApp))
end
end
end
else if (upper(CurrentMiscName) == 'SUNCALCPATH') then do
Value = bguifilereq(CurrentDir, SelectApp$':', winID,,'#?')
if (Value ~= '') & (upper(right(Value, 7)) == 'SUNCALC') then do
Value = pathpart(Value)
call bguiset(obj.currentvalue_, winID, STRINGA_TextVal,Value)
interpret 'SuncalcPath = 'QuoteIt(Value)
if (exists(SuncalcPath'suncalc')) & (~exists(Storage'Suncalc')) then do
address command 'copy 'SunCalcPath'suncalc 'Storage
do i = 0 to GroupCount
interpret 'call bguiset('grp.i',winID,MX_EnableButton,6,MX_EnableButton,7,MX_EnableButton,8)'
end
end
end
end
else if left(upper(CurrentMiscName), 11) == 'IMAGECLASS.' then do
Value = bguifilereq(CurrentDir, SelectImage$':', winID,,'#?')
if Value ~= '' then do
call bguiset(obj.currentvalue_, winID, STRINGA_TextVal,Value)
IC = MemberID(upper(substr(CurrentMiscName, 12)), 'ImageClass')
interpret 'ImageFile.'IC' = Value'
end
end
end
/**/
/***//*** ColorVarGad ***/
when id == id.colorvar_ then do
interpret CurrentColorName' = "'value('ColorList.'bguiget(obj.colorlist_, CYC_Active))'"'
CurrentColorName = value('ColorVarName.'bguiget(obj.colorvar_, CYC_Active))
call bguiset(obj.colorlist_,winID,CYC_Active,max(0, MemberID(Value(CurrentColorName),'ColorList')))
CurrentColor = bguiget(obj.colorlist_, CYC_Active)
end
/**/
/***//*** ColorListGad ***/
when id == id.colorlist_ then do
if (pos('BACKGROUND.', upper(CurrentColorName)) == 0) & (bguiget(obj.colorlist_, CYC_Active) == ColorList.Count - 1) then do
call bguireq('1b'x||"c"NotClear$,"*"OK$,'',winID)
call bguiset(obj.colorlist_, winID, CYC_Active, CurrentColor)
end
end
/**/
/***//*** CurrentVarGad ***/
when id == id.currentvar_ then do
Value = bguiget(obj.currentvalue_, STRINGA_TextVal)
if upper(left(CurrentMiscName, pos('.', CurrentMiscName))) == 'IMAGECLASS.' then do
IC = MemberID(upper(substr(CurrentMiscName, 12)), 'ImageClass')
interpret 'ImageFile.'IC' = Value'
end
else do
if datatype(Value) == 'CHAR' then Value = QuoteIt(Value)
interpret CurrentMiscName' = 'Value
end
CurrentMiscName = value('MiscVarName.'bguiget(obj.currentvar_, CYC_Active))
if upper(left(CurrentMiscName, pos('.', CurrentMiscName))) == 'IMAGECLASS.' then do
IC = MemberID(upper(substr(CurrentMiscName, 12)), 'ImageClass')
call bguiset(obj.currentvalue_,winID,STRINGA_TextVal,value('ImageFile.IC'))
end
else call bguiset(obj.currentvalue_,winID,STRINGA_TextVal,Value(CurrentMiscName))
UCMN = upper(CurrentMiscName)
if (UCMN == 'GFXAPPPATH') | (UCMN == 'SUNCALCPATH') | (UCMN == 'GFXAPP') | (left(UCMN, 11) == 'IMAGECLASS.') then VarReqGad = 1
else VarReqGad = 0
call bguiset(obj.addvar_, winID, GA_Disabled, ~VarReqGad)
end
/**/
/***//*** CurrentValueGad ***/
when id == id.currentvalue_ then do
if (upper(CurrentMiscName) == 'GFXAPPPATH') | (upper(CurrentMiscName) == 'GFXAPP') | (upper(CurrentMiscName) == 'SUNCALCPATH') then do
call bguireq('1b'x||"c"MustUse$,"*"OK$,'',winID)
call bguiset(obj.currentvalue_, winID,STRINGA_TextVal, value(CurrentMiscName))
end
else if left(upper(CurrentMiscName), 11) == 'IMAGECLASS.' then do
if bguiget(obj.currentvalue_, STRINGA_TextVal) ~= '' then do
call bguireq('1b'x||"c"MustUse$,"*"OK$,'',winID)
IC = MemberID(upper(substr(CurrentMiscName, 12)), 'ImageClass')
call bguiset(obj.currentvalue_, winID,STRINGA_TextVal, ImageFile.IC)
end
end
end
/**/
/***//*** SetHighlightsGad ***/
when id == id.sethighlights_ then do
EH_SelectMonth = bguiget(obj.monthchoice_, CYC_Active) + 1
call bguiwinbusy(winID)
do until DS_Done == 1
DS_Done = EditHighlight_BGUI()
end
call bguiwinready(winID)
end
/**/
/***//*** CalendarTypeGad ***/
when id == id.calendartype_ then do
CalType = bguiget(obj.calendartype_, CYC_Active) + 1
if (App == 'FW') & (CalType == 2) then CalType = 3
if CalType == 1 then do
call bguiset(obj.monthchoice_, winID, GA_Disabled, 0)
if App == 'PGS' then call bguiset(obj.endmonthchoice_, winID, GA_Disabled, 1)
end
else if CalType == 2 then do
call bguiset(obj.monthchoice_, winID, GA_Disabled, 0)
call bguiset(obj.endmonthchoice_, winID, GA_Disabled, 0)
end
else do
call bguiset(obj.monthchoice_, winID, GA_Disabled, 1)
if App == 'PGS' then call bguiset(obj.endmonthchoice_, winID, GA_Disabled, 1)
end
end
/**/
/***//*** GoGad ***/
when id == id.go_ then do
CalType = bguiget(obj.calendartype_, CYC_Active) + 1
if (App == 'FW') & (CalType == 2) then CalType = 3
EnteredYear = bguiget(obj.yearchoice_, STRINGA_TextVal)
Month = bguiget(obj.monthchoice_, CYC_Active) + 1
if CalType == 2 then EndMonth = bguiget(obj.endmonthchoice_, CYC_Active) + 1
Done = 1
end
/**/
/***//*** Extras Gads ***/
when id == id.bottomleft_ then call ControlMX(0, bguiget(obj.bottomleft_, MX_Active))
when id == id.bottomcenter_ then call ControlMX(1, bguiget(obj.bottomcenter_, MX_Active))
when id == id.bottomright_ then call ControlMX(2, bguiget(obj.bottomright_, MX_Active))
when id == id.topcenter_ then call ControlMX(3, bguiget(obj.topcenter_, MX_Active))
when id == id.topright_ then call ControlMX(4, bguiget(obj.topright_, MX_Active))
/**/
otherwise nop
end
if (Done == 1) | (Reset > 0) then leave
end
/**/
do DSR_Posn = 0 to PosnCount
interpret "Do"Do.DSR_Posn" = ''"
end
do DSR_Grp = 0 to GroupCount
DSR_Posn = DSR_Sel.DSR_Grp
interpret "Do"Do.DSR_Posn" = translate(DSR_Grp, 'BBBTT', '01234')||translate(DSR_Grp, 'LCRCR', '01234')"
end
if DoBothJ ~= '' then do
DoJulian = DoBothJ
DoJulianLeft = DoBothJ
end
if DoBothS ~= '' then do
DoSunrise = DoBothS
DoSunset = DoBothS
end
TopOption = sign(pos('T', DoPhases''DoWeeknumber''DoJulian''DoJulianLeft''DoSunrise''DoSunset))
if CalType ~= 0 then do
interpret CurrentFontName" = "QuoteIt(bguiget(obj.fontvalue_, STRINGA_TextVal))
interpret CurrentColorName' = "'value('ColorList.'bguiget(obj.colorlist_, CYC_Active))'"'
Value = bguiget(obj.currentvalue_, STRINGA_TextVal)
if upper(left(CurrentMiscName, pos('.', CurrentMiscName))) == 'IMAGECLASS.' then do
IC = MemberID(upper(substr(CurrentMiscName, 12)), 'ImageClass')
interpret 'ImageFile.'IC' = Value'
end
else do
if datatype(Value) == 'CHAR' then Value = QuoteIt(Value)
interpret CurrentMiscName' = 'Value
end
end
return
/**/
/***//*** DoSetupReq_CA () ***/
DoSetupReq_CA:
/***//*** GUI Description ***/
UpdateVarCmds = 0
NCColorReq = 0
ColorReq = 0
MonthList = '"'January$'|'February$'|'March$'|'April$'|'May$'|'June$'|'July$'|'August$'|'September$'|'October$'|'November$'|'December$'"'
if App == 'FW' then CalendarTypeList = '"'SingleMonth$'|'WholeYear$'"'
else CalendarTypeList = '"'SingleMonth$'|'MultiMonth$'|'WholeYear$'"'
call open('CA',"awnpipe:SetupReq/xc")
call ToPIPE('CA', '"'VarGUITitle$'" m cg dg v db si a cs sk sq h ps="'AppScreen'"')
call ToPIPE('CA', 'layout v si so cj')
DisplayNameGad = ToPIPE('CA', 'button ro b=0')
call AssignID('ClickTab', ToPIPE('CA', 'clicktab ctl="'OptLayout$'|'Variables$'|'Top$'|'Bottom$'"'))
/***//** Options & Layout Tab **/
call ToPIPE('CA', 'layout v si so b=0 page='ClickTab)
call ToPIPE('CA', 'layout b=3 gt="'Options$'"')
call ToPIPE('CA', 'layout v si so b=0')
call AssignID('MiniCalsGad', ToPIPE('CA', 'checkbox gt="'MiniCals$'"'))
call AssignID('HighlightsGad', ToPIPE('CA', 'checkbox gt="'Highlights$'"'))
call AssignID('ImagesGad', ToPIPE('CA', 'checkbox gt="'Images$'"'))
call AssignID('BoxDatesGad', ToPIPE('CA', 'checkbox gt="'BoxDates$'"'))
call ToPIPE('CA', 'le')
call ToPIPE('CA', 'layout v si so b=0')
call AssignID('ExtendedGad', ToPIPE('CA', 'checkbox gt="'Extended$'"'))
call AssignID('TopLongGad', ToPIPE('CA', 'checkbox gt="'TopLong$'"'))
call AssignID('NoteBoxGad', ToPIPE('CA', 'checkbox gt="'NoteBox$'"'))
call ToPIPE('CA', 'space')
call ToPIPE('CA', 'le')
call ToPIPE('CA', 'le')
call ToPIPE('CA', 'layout v si so cj b=3 gt="'OrientMarg$'"')
call ToPIPE('CA', 'layout b=0')
call ToPIPE('CA', 'space')
call AssignID('TopMargGad', ToPIPE('CA', 'string cj tc weiw=20'))
call ToPIPE('CA', 'space')
call ToPIPE('CA', 'le')
call ToPIPE('CA', 'layout si b=0')
call ToPIPE('CA', 'space')
call AssignID('LeftMargGad', ToPIPE('CA', 'string cj tc weiw=20'))
call AssignID('OrientationGad', ToPIPE('CA', 'chooser pu weiw=20 cl="'Wide$'|'Tall$'"'))
call AssignID('RightMargGad', ToPIPE('CA', 'string cj tc weiw=20'))
call ToPIPE('CA', 'space')
call ToPIPE('CA', 'le')
call ToPIPE('CA', 'layout b=0')
call ToPIPE('CA', 'space')
call AssignID('BottomMargGad', ToPIPE('CA', 'string cj tc weiw=20'))
call ToPIPE('CA', 'space')
call ToPIPE('CA', 'le')
call ToPIPE('CA', 'le')
call ToPIPE('CA', 'le')
if UpdateBusy(Req, 1) == -1 then call Cleanup
/**/
/***//** Variables Tab **/
call ToPIPE('CA', 'layout v si so b=0 page='ClickTab)
call ToPIPE('CA', 'layout so b=3 gt="'Fonts$'"')
call AssignID('FontVarGad', ToPIPE('CA', 'chooser pu maxn=50 weiw=45'))
call AssignID('FontValGad', ToPIPE('CA', 'string lj tc weiw=50'))
call AssignID('ChooseFontGad', ToPIPE('CA', 'button ab=2 weiw=0 weih=0'))
call ToPIPE('CA', 'le')
call ToPIPE('CA', 'layout v b=3 gt="'Colors$'" si so')
call ToPIPE('CA', 'layout b=0')
call AssignID('ColorVarGad', ToPIPE('CA', 'button weiw=50 weih=0'))
call AssignID('CycleColorVarGad', ToPIPE('CA', 'button weiw=0 gt=">"'))
call AssignID('ColorValGad', ToPIPE('CA', 'button weiw=45 weih=0'))
call ToPIPE('CA', 'le')
call AssignID('MatchColorsGad', ToPIPE('CA', 'checkbox gt="'MatchColors$'"'))
call AssignID('DailyColorsGad', ToPIPE('CA', 'checkbox gt="'DailyColors$'"'))
call ToPIPE('CA', 'le')
call ToPIPE('CA', 'layout v b=3 gt="'MiscVar$'" si so')
call ToPIPE('CA', 'layout b=0')
call ToPIPE('CA', 'space')
call AssignID('HighlightEditGad', ToPIPE('CA', 'button gt="'HighlightEd$'"'))
call ToPIPE('CA', 'space')
call ToPIPE('CA', 'le')
call ToPIPE('CA', 'layout b=0')
call AssignID('MiscVarGad', ToPIPE('CA', 'button weiw=50'))
call AssignID('CycleMiscVarGad', ToPIPE('CA', 'button weiw=0 gt=">"'))
call AssignID('MiscValGad', ToPIPE('CA', 'string lj tc weiw=40 weih=0'))
call AssignID('ChooseValGad', ToPIPE('CA', 'button ab=0 weiw=0 weih=0'))
call AssignID('AddImageClassGad', ToPIPE('CA', 'button weiw=0 gt="'AddIC$'"'))
call ToPIPE('CA', 'le')
call ToPIPE('CA', 'le')
call ToPIPE('CA', 'le')
GadText.CycleColorVarGad.0 = '>'
GadText.CycleColorVarGad.1 = '<'
GadText.CycleMiscVarGad.0 = '>'
GadText.CycleMiscVarGad.1 = '<'
if UpdateBusy(Req, 1) == -1 then call Cleanup
/**/
/***//** Top Options Tab **/
call ToPIPE('CA', 'layout b=0 page='ClickTab)
call ToPIPE('CA', 'space')
call ToPIPE('CA', 'layout v cj b=3')
call ToPIPE('CA', 'label gt="'Top$'*n'Center$'"')
call ToPIPE('CA', 'layout v so b=0')
call AssignID('Gad.3.0', ToPIPE('CA', 'checkbox gt="'None$'"'))
call AssignID('Gad.3.1', ToPIPE('CA', 'checkbox gt="'Phases$'"'))
call AssignID('Gad.3.2', ToPIPE('CA', 'checkbox gt="'Weeknumber$'"'))
call AssignID('Gad.3.3', ToPIPE('CA', 'checkbox gt="'Julian$'"'))
call AssignID('Gad.3.4', ToPIPE('CA', 'checkbox gt="'JulLeft$'"'))
call AssignID('Gad.3.5', ToPIPE('CA', 'checkbox gt="'JulJulLeft$'"'))
call AssignID('Gad.3.6', ToPIPE('CA', 'checkbox gt="'Sunrise$'"'))
call AssignID('Gad.3.7', ToPIPE('CA', 'checkbox gt="'Sunset$'"'))
call AssignID('Gad.3.8', ToPIPE('CA', 'checkbox gt="'RiseSet$'"'))
call ToPIPE('CA', 'space')
call ToPIPE('CA', 'le')
call ToPIPE('CA', 'le')
call ToPIPE('CA', 'layout v cj b=3')
call ToPIPE('CA', 'label gt="'Top$'*n'Right$'"')
call ToPIPE('CA', 'layout v so b=0')
call AssignID('Gad.4.0', ToPIPE('CA', 'checkbox gt="'None$'"'))
call AssignID('Gad.4.1', ToPIPE('CA', 'checkbox gt="'Phases$'"'))
call AssignID('Gad.4.2', ToPIPE('CA', 'checkbox gt="'Weeknumber$'"'))
call AssignID('Gad.4.3', ToPIPE('CA', 'checkbox gt="'Julian$'"'))
call AssignID('Gad.4.4', ToPIPE('CA', 'checkbox gt="'JulLeft$'"'))
call AssignID('Gad.4.5', ToPIPE('CA', 'checkbox gt="'JulJulLeft$'"'))
call AssignID('Gad.4.6', ToPIPE('CA', 'checkbox gt="'Sunrise$'"'))
call AssignID('Gad.4.7', ToPIPE('CA', 'checkbox gt="'Sunset$'"'))
call AssignID('Gad.4.8', ToPIPE('CA', 'checkbox gt="'RiseSet$'"'))
call ToPIPE('CA', 'space')
call ToPIPE('CA', 'le')
call ToPIPE('CA', 'le')
call ToPIPE('CA', 'le')
if UpdateBusy(Req, 1) == -1 then call Cleanup
/**/
/***//** Bottom Options Tab **/
call ToPIPE('CA', 'layout b=0 page='ClickTab)
call ToPIPE('CA', 'layout v cj b=3')
call ToPIPE('CA', 'label gt="'Bottom$'*n'Left$'"')
call ToPIPE('CA', 'layout v so b=0')
call AssignID('Gad.0.0', ToPIPE('CA', 'checkbox gt="'None$'"'))
call AssignID('Gad.0.1', ToPIPE('CA', 'checkbox gt="'Phases$'"'))
call AssignID('Gad.0.2', ToPIPE('CA', 'checkbox gt="'Weeknumber$'"'))
call AssignID('Gad.0.3', ToPIPE('CA', 'checkbox gt="'Julian$'"'))
call AssignID('Gad.0.4', ToPIPE('CA', 'checkbox gt="'JulLeft$'"'))
call AssignID('Gad.0.5', ToPIPE('CA', 'checkbox gt="'JulJulLeft$'"'))
call AssignID('Gad.0.6', ToPIPE('CA', 'checkbox gt="'Sunrise$'"'))
call AssignID('Gad.0.7', ToPIPE('CA', 'checkbox gt="'Sunset$'"'))
call AssignID('Gad.0.8', ToPIPE('CA', 'checkbox gt="'RiseSet$'"'))
call ToPIPE('CA', 'space')
call ToPIPE('CA', 'le')
call ToPIPE('CA', 'le')
call ToPIPE('CA', 'layout v cj b=3')
call ToPIPE('CA', 'label gt="'Bottom$'*n'Center$'"')
call ToPIPE('CA', 'layout v so b=0')
call AssignID('Gad.1.0', ToPIPE('CA', 'checkbox gt="'None$'"'))
call AssignID('Gad.1.1', ToPIPE('CA', 'checkbox gt="'Phases$'"'))
call AssignID('Gad.1.2', ToPIPE('CA', 'checkbox gt="'Weeknumber$'"'))
call AssignID('Gad.1.3', ToPIPE('CA', 'checkbox gt="'Julian$'"'))
call AssignID('Gad.1.4', ToPIPE('CA', 'checkbox gt="'JulLeft$'"'))
call AssignID('Gad.1.5', ToPIPE('CA', 'checkbox gt="'JulJulLeft$'"'))
call AssignID('Gad.1.6', ToPIPE('CA', 'checkbox gt="'Sunrise$'"'))
call AssignID('Gad.1.7', ToPIPE('CA', 'checkbox gt="'Sunset$'"'))
call AssignID('Gad.1.8', ToPIPE('CA', 'checkbox gt="'RiseSet$'"'))
call AssignID('Gad.1.9', ToPIPE('CA', 'checkbox gt="'History$'"'))
call AssignID('Gad.1.10', ToPIPE('CA', 'checkbox gt="'Random$'"'))
call ToPIPE('CA', 'space')
call ToPIPE('CA', 'le')
call ToPIPE('CA', 'le')
call ToPIPE('CA', 'layout v cj b=3')
call ToPIPE('CA', 'label gt="'Bottom$'*n'Right$'"')
call ToPIPE('CA', 'layout v so b=0')
call AssignID('Gad.2.0', ToPIPE('CA', 'checkbox gt="'None$'"'))
call AssignID('Gad.2.1', ToPIPE('CA', 'checkbox gt="'Phases$'"'))
call AssignID('Gad.2.2', ToPIPE('CA', 'checkbox gt="'Weeknumber$'"'))
call AssignID('Gad.2.3', ToPIPE('CA', 'checkbox gt="'Julian$'"'))
call AssignID('Gad.2.4', ToPIPE('CA', 'checkbox gt="'JulLeft$'"'))
call AssignID('Gad.2.5', ToPIPE('CA', 'checkbox gt="'JulJulLeft$'"'))
call AssignID('Gad.2.6', ToPIPE('CA', 'checkbox gt="'Sunrise$'"'))
call AssignID('Gad.2.7', ToPIPE('CA', 'checkbox gt="'Sunset$'"'))
call AssignID('Gad.2.8', ToPIPE('CA', 'checkbox gt="'RiseSet$'"'))
call ToPIPE('CA', 'space')
call ToPIPE('CA', 'le')
call ToPIPE('CA', 'le')
call ToPIPE('CA', 'le')
if UpdateBusy(Req, 1) == -1 then call Cleanup
/**/
/***//** Control Buttons **/
call ToPIPE('CA', 'layout si so b=0')
call ToPIPE('CA', 'space')
call AssignID('SwitchGad1', ToPIPE('CA', 'chooser pu cl='MonthList))
call AssignID('SwitchGad2', ToPIPE('CA', 'integer a tc weiw=5 maxc=4'))
call AssignID('SwitchGad3', ToPIPE('CA', 'button b=0 weiw=30 weih=0 gt=""'))
call ToPIPE('CA', 'space')
call ToPIPE('CA', 'le')
call ToPIPE('CA', 'layout cj si so b=0')
call AssignID('CalendarTypeGad', ToPIPE('CA', 'chooser pu weiw=0 weih=0 cl='CalendarTypeList))
call AssignID('GoGad', ToPIPE('CA', 'button weih=0 gt="'Go$'"'))
call ToPIPE('CA', 'space')
call AssignID('ResetGad', ToPIPE('CA', 'button weih=0 gt="'Reset$'"'))
call AssignID('LoadGad', ToPIPE('CA', 'button weih=0 gt="'Load$'"'))
call AssignID('SaveAsGad', ToPIPE('CA', 'button weih=0 gt="'SaveAs$'"'))
call ToPIPE('CA', 'space')
call AssignID('CancelGad', ToPIPE('CA', 'button weih=0 gt="'Cancel$'" c'))
call ToPIPE('CA', 'le')
if UpdateBusy(Req, 1) == -1 then call Cleanup
/**/
/***//*** Other Objects ***/
GetFileAllGad = ToPIPE('CA', 'getfile ua pat="#?"')
GetFileDataGad = ToPIPE('CA', 'getfile ua pat="#?.(data|prefs)"')
if App == 'PGS' then do
call open('FontReq', "awnpipe:FontReq/xc")
call ToPIPE('FontReq', '"'SelectFont$'" m db dg v db a ps="'AppScreen'"')
call ToPIPE('FontReq', 'listbrowser minw=200 minh=300')
do DSR_FontNumber = 0 to FontList.COUNT - 1
GadID = ToPIPE('FontReq', 'browsernode gt="'FontList.DSR_FontNumber'"')
interpret 'FontGad.'GadID' = 'DSR_FontNumber
end
end
call open('ColorReq','awnpipe:ColorReq/xc')
call ToPIPE('ColorReq','"Select color:" m db dg v a ps="'AppScreen'"')
call ToPIPE('ColorReq','listbrowser minw 150 minh 75 lbl "Color|Sample"')
call open('NCColorReq','awnpipe:NCColorReq/xc')
call ToPIPE('NCColorReq','"Select color:" m db dg v a ps="'AppScreen'"')
call ToPIPE('NCColorReq','listbrowser minw 150 minh 75 lbl "Color|Sample"')
if App == 'FW' then do
do GE_ColorNumber = 0 to ColorList.Count - 2
if UpdateBusy(Req, 1) == -1 then call Cleanup
RPen = dTox(x2d(left(ColorRegister.GE_ColorNumber, 2)) / 255 * 4294967295)
GPen = dTox(x2d(substr(ColorRegister.GE_ColorNumber, 3, 2)) / 255 * 4294967295)
BPen = dTox(x2d(right(ColorRegister.GE_ColorNumber, 2)) / 255 * 4294967295)
call ToPIPE('ColorReq','penmap pmp 1|'RPen'|'GPen'|'BPen' pmd 0|'d2x(ColorW)'|0|'d2x(ColorH)''copies('|0', ColorW * ColorH))
GadID = ToPIPE('ColorReq','browsernode gt="'ColorList.GE_ColorNumber'|¶"')
interpret 'ColorGad.'GadID' = 'GE_ColorNumber
call ToPIPE('NCColorReq','penmap pmp 1|'RPen'|'GPen'|'BPen' pmd 0|'d2x(ColorW)'|0|'d2x(ColorH)''copies('|0', ColorW * ColorH))
GadID = ToPIPE('NCColorReq','browsernode gt="'ColorList.GE_ColorNumber'|¶"')
interpret 'NCColorGad.'GadID' = 'GE_ColorNumber
end
GadID = ToPIPE('ColorReq','browsernode gt="<'Clear$'>|¶"')
interpret 'ColorGad.'GadID' = 'GE_ColorNumber
end
else if App == 'PGS' then do
do GE_ColorNumber = 0 to ColorList.Count - 2
if UpdateBusy(Req, 1) == -1 then call Cleanup
GadID = ToPIPE('ColorReq','browsernode gt="'ColorList.GE_ColorNumber'|"')
interpret 'ColorGad.'GadID' = 'GE_ColorNumber
GadID = ToPIPE('NCColorReq','browsernode gt="'ColorList.GE_ColorNumber'|"')
interpret 'NCColorGad.'GadID' = 'GE_ColorNumber
end
GadID = ToPIPE('ColorReq','browsernode gt="<'Clear$'>|"')
interpret 'ColorGad.'GadID' = 'GE_ColorNumber
end
/**/
call ToPIPE('CA', 'le')
call ToPIPE('CA', "open")
if UpdateBusy(Req, 1) == -1 then call Cleanup
/**/
/***//*** GUI Action Loop ***/
call CA_UpdateGads
Done = 0
do until Done == 1
call ToPIPE('CA', 'continue')
DSR_EventInfo = readln('CA')
parse var DSR_EventInfo DSR_Event' 'DSR_GadID' 'DSR_GadInfo1
select
when DSR_Event == 'close' then call Cleanup
/***//*** Help event ***/
when DSR_Event == 'help' then do
if DSR_GadID ~= -1 then do
OverGad = DSR_GadID
if (DSR_GadID ~= ShiftedGad) & (ShiftedGad > 0) then do
call ToPIPE('CA', 'id 'ShiftedGad' gt="'GadText.ShiftedGad.0'"')
ShiftedGad = 0
end
if (ShiftDown == 1) & (symbol('GadText.OverGad.1') == 'VAR') then do
call ToPIPE('CA', 'id 'OverGad' gt="'GadText.OverGad.1'"')
ShiftedGad = OverGad
end
end
end
/**/
/***//*** Qualifier event ***/
when DSR_Event == 'qual' then do
ShiftDown = (DSR_GadID == 1)|(DSR_GadID == 2)
if (ShiftDown == 0) & (ShiftedGad > 0) then do
call ToPIPE('CA', 'id 'ShiftedGad' gt="'GadText.OverGad.0'"')
ShiftedGad = 0
end
if (ShiftDown == 1) & (symbol('GadText.OverGad.1') == 'VAR') then do
call ToPIPE('CA', 'id 'OverGad' gt="'GadText.OverGad.1'"')
ShiftedGad = OverGad
end
end
/**/
/***//*** Key event ***/
when DSR_Event == 'key' then do
HelpGad = DSR_Help.OverGad
interpret 'HelpText = Help$.'HelpGad
if (DSR_GadID == 95) & (symbol('Help$.'HelpGad) == 'VAR') & (HelpText ~= '') then
call CASimpleReq(Help$, HelpText, HelpTime)
end
/**/
/***//*** CalendarTypeGad ***/
when DSR_GadID == CalendarTypeGad then do
call ReadMonthYearGads
CalType = DSR_GadInfo1 + 1
if (App == 'FW') & (CalType == 2) then CalType = 3
if CalType == 1 then do
call AssignID('SwitchGad1', ToPIPE('CA', 'define chooser replace='SwitchGad1' pu cl='MonthList' s='Month - 1))
call AssignID('SwitchGad2', ToPIPE('CA', 'define integer replace='SwitchGad2' a tc weiw=5 maxc=4 defn='EnteredYear))
call AssignID('SwitchGad3', ToPIPE('CA', 'define button replace='SwitchGad3' b=0 gt=""'))
call ToPIPE('CA', 'refresh')
Help$.SwitchGad1Help = Help$.MonthGadHelp
Help$.SwitchGad2Help = Help$.YearGadHelp
Help$.SwitchGad3Help = ''
end
else if CalType == 2 then do
call AssignID('SwitchGad1', ToPIPE('CA', 'define chooser replace='SwitchGad1' pu cl='MonthList' s='Month - 1))
call AssignID('SwitchGad2', ToPIPE('CA', 'define chooser replace='SwitchGad2' pu cl='MonthList' s='EndMonth - 1))
call AssignID('SwitchGad3', ToPIPE('CA', 'define integer replace='SwitchGad3' a tc weiw=5 maxc=4 defn='EnteredYear))
call ToPIPE('CA', 'refresh')
Help$.SwitchGad1Help = Help$.StartMonthGadHelp
Help$.SwitchGad2Help = Help$.EndMonthGadHelp
Help$.SwitchGad3Help = Help$.YearGadHelp
end
else do
call AssignID('SwitchGad1', ToPIPE('CA', 'define button replace='SwitchGad1' b=0 gt=""'))
call AssignID('SwitchGad2', ToPIPE('CA', 'define integer replace='SwitchGad2' a tc weiw=5 maxc=4 defn='EnteredYear))
call AssignID('SwitchGad3', ToPIPE('CA', 'define button replace='SwitchGad3' b=0 gt=""'))
call ToPIPE('CA', 'refresh')
Help$.SwitchGad1Help = ''
Help$.SwitchGad2Help = Help$.YearGadHelp
Help$.SwitchGad3Help = ''
end
end
/**/
/***//*** GoGad ***/
when DSR_GadID == GoGad then do
CalType = ReadCAGad('CA', CalendarTypeGad) + 1
if (App == 'FW') & (CalType == 2) then CalType = 3
call ReadMonthYearGads
call CA_InterpretMX
Done = 1
end
/**/
/***//*** ResetGad ***/
when DSR_GadID == ResetGad then do
PrefsFile = 'Default'
call WriteFile('ENV:FWCalendar', PrefsFile, 'B')
call CA_UpdateGads
end
/**/
/***//*** LoadGad ***/
when DSR_GadID == LoadGad then do
if PrefsFile ~= 'Default' then do
DefaultSource = PathPart(PrefsFile)
DefaultFile = FilePart(PrefsFile)
end
else do
DefaultSource = ScriptDir
DefaultFile = 'FWCalendar.prefs'
end
DSR_File = CAGetFile('CA', GetFileDataGad, SelectFile$, DefaultSource''DefaultFile)
if (DSR_File ~= '') & (exists(DSR_File)) then do
PrefsFile = DSR_File
call WriteFile('ENV:FWCalendar', PrefsFile, 'B')
GSI_Data = ReadFile(PrefsFile)
GSI_UpperData = upper(GSI_Data)
call CA_UpdateGads
end
else do
call ToPIPE('CA', 'id 0 s=256')
call CASimpleReq('FWCalendar 'Notice$, PrefsFile' 'CantFind$'...')
call ToPIPE('CA', 'id 0 s=512')
end
end
/**/
/***//*** SaveAsGad ***/
when DSR_GadID == SaveAsGad then do
if PrefsFile ~= 'Default' then do
DefaultSource = PathPart(PrefsFile)
DefaultFile = FilePart(PrefsFile)
end
else do
DefaultSource = ScriptDir
DefaultFile = 'FWCalendar.prefs'
end
DSR_File = CAGetFile('CA', GetFileDataGad, SelectPrefs$, DefaultSource''DefaultFile)
if DSR_File ~= '' then do
PrefsFile = DSR_File
call WriteFile('ENV:FWCalendar', PrefsFile, 'B')
end
end
/**/
/***//*** ExtendedGad ***/
when DSR_GadID == ExtendedGad then do
DoExtended = DSR_GadInfo1
if DoExtended == 1 then do
call ToPIPE('CA', 'id 'TopLongGad' s=0 dis=1 page='ClickTab' refresh')
call ToPIPE('CA', 'id 'NoteBoxGad' s=0 dis=1 page='ClickTab' refresh')
DoTopExtraWk = 0
DoNoteBox = 0
end
else do
call ToPIPE('CA', 'id 'TopLongGad' dis=0 page='ClickTab' refresh')
call ToPIPE('CA', 'id 'NoteBoxGad' dis=0 page='ClickTab' refresh')
end
end
/**/
/***//*** OrientationGad ***/
when DSR_GadID == OrientationGad then do
if DSR_GadInfo1 == 0 then Orientation = 'Wide'
else Orientation = 'Tall'
end
/**/
/***//*** Checkbox Gads ***/
when DSR_GadID == MinicalsGad then DoMiniCals = DSR_GadInfo1
when DSR_GadID == HighlightsGad then DoHighlights = DSR_GadInfo1
when DSR_GadID == TopLongGad then DoTopExtraWk = DSR_GadInfo1
when DSR_GadID == NoteBoxGad then DoNoteBox = DSR_GadInfo1
when DSR_GadID == BoxDatesGad then DoDateBox = DSR_GadInfo1
when DSR_GadID == ImagesGad then DoImages = DSR_GadInfo1
when DSR_GadID == MatchColorsGad then DoMatchColors = DSR_GadInfo1
when DSR_GadID == DailyColorsGad then DoDailyColors = DSR_GadInfo1
/**/
/***//*** FontValGad ***/
when DSR_GadID == FontValGad then do
if DSR_GadInfo1 ~= value(CurrentFontName) then do
call ToPIPE('CA', 'id 0 s=256')
call CASimpleReq('FWCalendar 'Notice$, MustUse$)
call ToPIPE('CA', 'id 0 s=512')
call ToPIPE('CA', 'id 'FontValGad' gt="'value(CurrentFontName)'" page='ClickTab' refresh')
end
end
/**/
/***//*** ChooseFontGad ***/
when DSR_GadID == ChooseFontGad then do
if App == 'FW' then do
DSR_File = CAGetFile('CA', GetFileAllGad, SelectFont$, CurrentDir'FWFonts/SWOLFonts/')
if DSR_File ~= '' then do
interpret CurrentFontName" = "QuoteIt(DSR_File)
call ToPIPE('CA', 'id 'FontValGad' gt="'value(CurrentFontName)'" page='ClickTab' refresh')
end
end
else if App == 'PGS' then do
call ToPIPE('CA', 'id 0 s=256')
interpret CurrentFontName" = "QuoteIt(ReadBrowserList('FontReq', 'FontGad', 'FontList', value(CurrentFontName)))
call ToPIPE('CA', 'id 'FontValGad' gt="'value(CurrentFontName)'" page='ClickTab' refresh')
call ToPIPE('CA', 'id 0 s=512')
end
end
/**/
/***//*** FontVarGad ***/
when DSR_GadID == FontVarGad then do
CurrentFontName = FontVarName.DSR_GadInfo1
call ToPIPE('CA', 'id 'FontValGad' gt="'value(CurrentFontName)'" page='ClickTab' refresh')
end
/**/
/***//*** ColorVarGad ***/
when DSR_GadID == ColorVarGad then do
call ToPIPE('CA', 'id 0 s=256')
CurrentColorName = ReadBrowserList('ColorVarReq', 'ColorVarGad', 'ColorVarName', CurrentColorName)
call ToPIPE('CA', 'id 'ColorVarGad' gt="'CurrentColorName'" page='ClickTab)
call ToPIPE('CA', 'id 'ColorValGad' gt="'value(CurrentColorName)'" page='ClickTab)
call ToPIPE('CA', 'id 0 s=512')
end
/**/
/***//*** CycleColorVarGad ***/
when DSR_GadID == CycleColorVarGad then do
CurrentColorNum = MemberID(CurrentColorName, 'ColorVarName')
if ShiftDown == 1 then do
CurrentColorNum = CurrentColorNum - 1
if CurrentColorNum < 0 then CurrentColorNum = ColorVarName.Count - 1
end
else do
CurrentColorNum = CurrentColorNum + 1
if CurrentColorNum = ColorVarName.Count then CurrentColorNum = 0
end
CurrentColorName = ColorVarName.CurrentColorNum
call ToPIPE('CA', 'id 'ColorVarGad' gt="'CurrentColorName'" page='ClickTab)
call ToPIPE('CA', 'id 'ColorValGad' gt="'value(CurrentColorName)'" page='ClickTab)
end
/**/
/***//*** ColorValGad ***/
when DSR_GadID == ColorValGad then do
call ToPIPE('CA', 'id 0 s=256')
if pos('BACKGROUND.', upper(CurrentColorName)) == 0 then CurrentColor = ReadBrowserList('NCColorReq', 'NCColorGad', 'NCColorList')
else CurrentColor = ReadBrowserList('ColorReq', 'ColorGad', 'ColorList')
interpret CurrentColorName' = "'CurrentColor'"'
call ToPIPE('CA', 'id 'ColorValGad' gt="'CurrentColor'" page='ClickTab)
call ToPIPE('CA', 'id 0 s=512')
end
/**/
/***//*** MiscVarGad ***/
when DSR_GadID == MiscVarGad then do
call ProcessMiscValGad(ReadCAGad('CA', MiscValGad))
call ToPIPE('CA', 'id 0 s=256')
CurrentMiscName = ReadBrowserList('MiscVarReq', 'MiscVarGad', 'MiscVarName', CurrentMiscName)
call UpdateMiscVarGad
call ToPIPE('CA', 'id 0 s=512')
end
/**/
/***//*** CycleMiscVarGad ***/
when DSR_GadID == CycleMiscVarGad then do
call ProcessMiscValGad(ReadCAGad('CA', MiscValGad))
CurrentMiscNum = MemberID(CurrentMiscName, 'MiscVarName')
if ShiftDown == 1 then do
CurrentMiscNum = CurrentMiscNum - 1
if CurrentMiscNum < 0 then CurrentMiscNum = MiscVarName.Count - 1
end
else do
CurrentMiscNum = CurrentMiscNum + 1
if CurrentMiscNum = MiscVarName.Count then CurrentMiscNum = 0
end
CurrentMiscName = MiscVarName.CurrentMiscNum
call UpdateMiscVarGad
end
/**/
/***//*** MiscValGad ***/
when DSR_GadID == MiscValGad then do
if VarReqGad == 0 then do
if left(upper(CurrentMiscName), 11) == 'IMAGECLASS.' then do
if DSR_GadInfo1 ~= '' then do
call ToPIPE('CA', 'id 0 s=256')
call CASimpleReq('FWCalendar 'Notice$, MustUse$)
call ToPIPE('CA', 'id 0 s=512')
IC = MemberID(upper(substr(CurrentMiscName, 12)), 'ImageClass')
call ToPIPE('CA', 'id 'MiscValGad' gt="'ImageFile.IC'" page='ClickTab' refresh')
end
else do
IC = MemberID(upper(substr(CurrentMiscName, 12)), 'ImageClass')
call ToPIPE('CA', 'id 'MiscValGad' gt="" page='ClickTab' ref')
interpret "ImageFile."IC" = DSR_GadInfo1"
end
end
else do
call ToPIPE('CA', 'id 0 s=256')
call CASimpleReq('FWCalendar 'Notice$, MustUse$)
call ToPIPE('CA', 'id 0 s=512')
call ToPIPE('CA', 'id 'MiscValGad' gt="'value(CurrentMiscName)'" page='ClickTab' refresh')
end
end
else call ProcessMiscValGad(DSR_GadInfo1)
end
/**/
/***//*** ChooseValGad ***/
when DSR_GadID == ChooseValGad then do
if (upper(CurrentMiscName) == 'GFXAPPPATH') | (upper(CurrentMiscName) == 'GFXAPP') then do
DSR_File = CAGetFile('CA', GetFileAllGad, SelectApp$, CheckDir(GfxAppPath))
if DSR_File ~= '' then do
PathPart = pathpart(DSR_File)
FilePart = filepart(DSR_File)
if upper(CurrentMiscName) == 'GFXAPPPATH' then call ToPIPE('CA', 'id 'MiscValGad' gt="'PathPart'" page='ClickTab' refresh')
else call ToPIPE('CA', 'id 'MiscValGad' gt="'FilePart'" page='ClickTab' ref')
interpret 'GfxAppPath = 'QuoteIt(PathPart)
interpret 'GfxApp = 'QuoteIt(FilePart)
if (exists(GfxAppPath''GfxApp)) & (~exists(Storage''GfxApp)) then address command 'copy 'GfxAppPath''GfxApp' 'Storage
if exists(Storage''GfxApp) then call ToPIPE('CA', 'id 'ImagesGad' dis=0 page='ClickTab' refresh')
end
end
else if pos('IMAGECLASS.', upper(CurrentMiscName)) > 0 then do
IC = MemberID(upper(substr(CurrentMiscName, 12)), 'ImageClass')
DSR_File = CAGetFile('CA', GetFileAllGad, SelectImage$, CheckDir(PathPart(ImageFile.IC)))
if DSR_File ~= '' then do
call ToPIPE('CA', 'id 'MiscValGad' gt="'DSR_File'" page='ClickTab' ref')
interpret "ImageFile."IC" = DSR_File"
end
end
else do
if upper(CurrentMiscName) == 'SUNCALCPATH' then do
DSR_File = CAGetFile('CA', GetFileAllGad, SelectApp$, CheckDir(SunCalcPath))
if DSR_File ~= '' then do
PathPart = pathpart(DSR_File)
call ToPIPE('CA', 'id 'MiscValGad' gt="'PathPart'" page='ClickTab' ref')
interpret 'SuncalcPath = 'QuoteIt(PathPart)
if (exists(SuncalcPath'suncalc') == 1) & (exists(Storage'Suncalc') == 0) then address command 'copy 'SunCalcPath'suncalc 'Storage
if exists(Storage'SunCalc') == 1 then do
do DSR_Grp = 0 to GroupCount
call ToPIPE('CA', 'id 'Gad.DSR_Grp.6' dis=0 page='ClickTab' ref')
call ToPIPE('CA', 'id 'Gad.DSR_Grp.7' dis=0 page='ClickTab' ref')
call ToPIPE('CA', 'id 'Gad.DSR_Grp.8' dis=0 page='ClickTab' ref')
end
end
end
end
end
end
/**/
/***//*** HighlightEditGad ***/
when DSR_GadID == HighlightEditGad then do
EH_SelectMonth = Month
call ToPIPE('CA', 'id 0 s=256')
call EditHighlight_CA
call ToPIPE('CA', 'id 0 s=512')
end
/**/
/***//*** AddImageClassGad ***/
when DSR_GadID == AddImageClassGad then do
call ToPIPE('CA', 'id 0 s=256')
call open('Req', "awnpipe:SimpleReq/xc")
call ToPIPE('Req', '"'EnterNewIC$'" m v db dg si so a ps="'AppScreen'"')
Req_StringGad = ToPIPE('Req', 'string cj minw=200 gt=""')
call ToPIPE('Req', 'layout b=0 si so cj')
call ToPIPE('Req', 'space')
Req_DoneGad = ToPIPE('Req', 'button c gt="'OK$'"')
call ToPIPE('Req', 'space')
call ToPIPE('Req', 'le')
call ToPIPE('Req', 'open')
call ToPIPE('Req', 'id 'Req_StringGad' s=1')
NewImageClass = ''
do until eof('Req')
call ToPIPE('Req', 'continue')
Req_EventInfo = readln('Req')
parse var Req_EventInfo Req_Event' 'Req_GadID' 'Req_GadInfo1
if Req_Event == 'close' then NewImageClass = ReadCAGad('Req', Req_StringGad)
if Req_GadID == Req_StringGad then NewImageClass = Req_GadInfo1
end
call close('Req')
call ToPIPE('CA', 'id 0 s=512')
if NewImageClass ~= '' then do
ImageClass.ImgClassCount = NewImageClass
NewImageFile = ''
interpret "ImageFile."ImgClassCount" = NewImageFile"
ImgClassCount = ImgClassCount + 1
MiscVarName.MiscVarCount = 'ImageClass.'NewImageClass
UpdateVarCmd.UpdateVarCmds = 'id 'MiscVarListID' addnode tar=-1 gt="ImageClass.'NewImageClass'"'
UpdateVarNum.UpdateVarCmds = MiscVarCount
UpdateVarCmds = UpdateVarCmds + 1
MiscVarCount = MiscVarCount + 1
MiscVarName.COUNT = MiscVarCount
ImageClass.COUNT = ImgClassCount
CurrentMiscName = 'ImageClass.'NewImageClass
call UpdateMiscVarGad
end
end
/**/
otherwise do
/***//*** MX Gads ***/
if symbol('DSR_Gad.DSR_GadID') == 'VAR' then do
parse var DSR_Gad.DSR_GadID .'.'DSR_Grp'.'DSR_Posn
if DSR_Grp ~= '' then call ControlMX(DSR_Grp, DSR_Posn)
end
/**/
end
end
if (DSR_Event = 'gadget') & (ShiftDown = 1) & (symbol('GadText.DSR_GadID.1') == 'VAR') then do
ShiftedGad = DSR_GadID
OverGad = DSR_GadID
call ToPIPE('CA', 'id 'ShiftedGad' gt="'GadText.ShiftedGad.1'"')
end
end
Margin.Top = ReadCAGad('CA', TopMargGad)
Margin.Left = ReadCAGad('CA', LeftMargGad)
Margin.Right = ReadCAGad('CA', RightMargGad)
Margin.Bottom = ReadCAGad('CA', BottomMargGad)
return
/**/
/***//*** CA_Interpret MX ***/
CA_InterpretMX:
do DSR_Posn = 0 to PosnCount
interpret "Do"Do.DSR_Posn" = ''"
end
do DSR_Grp = 0 to GroupCount
DSR_Posn = DSR_Sel.DSR_Grp
interpret "Do"Do.DSR_Posn" = translate(DSR_Grp, 'BBBTT', '01234')||translate(DSR_Grp, 'LCRCR', '01234')"
end
if DoBothJ ~= '' then do
DoJulian = DoBothJ
DoJulianLeft = DoBothJ
end
if DoBothS ~= '' then do
DoSunrise = DoBothS
DoSunset = DoBothS
end
TopOption = sign(pos('T', DoPhases''DoWeeknumber''DoJulian''DoJulianLeft''DoSunrise''DoSunset))
return
/**/
/***//*** ProcessMiscValGad ***/
ProcessMiscValGad:
parse arg Value
if datatype(Value) == 'CHAR' then Value = QuoteIt(Value)
interpret CurrentMiscName' = 'Value
if (upper(CurrentMiscName) == 'PREFSNAME') then do
if PrefsName == '' then PrefsName = PrefsFile
call ToPIPE('CA', 'id 'DisplayNameGad' gt="'value(CurrentMiscName)'" ref')
end
if HostScreen ~= '' then AppScreen = HostScreen
return
/**/
/***//*** ReadMonthYearGads ***/
ReadMonthYearGads:
if CalType == 1 then do
Month = ReadCAGad('CA', SwitchGad1) + 1
EnteredYear = ReadCAGad('CA', SwitchGad2)
end
else if CalType == 2 then do
Month = ReadCAGad('CA', SwitchGad1) + 1
EndMonth = ReadCAGad('CA', SwitchGad2) + 1
EnteredYear = ReadCAGad('CA', SwitchGad3)
end
else EnteredYear = ReadCAGad('CA', SwitchGad2)
return
/**/
/***//*** UpdateMiscVarGad ***/
UpdateMiscVarGad:
call ToPIPE('CA', 'id 'MiscVarGad' gt="'CurrentMiscName'" page='ClickTab)
if upper(left(CurrentMiscName, pos('.', CurrentMiscName))) == 'IMAGECLASS.' then do
IC = MemberID(upper(substr(CurrentMiscName, 12)), 'ImageClass')
call ToPIPE('CA', 'id 'MiscValGad' gt="'value("ImageFile.IC")'" page='ClickTab' refresh')
end
else call ToPIPE('CA', 'id 'MiscValGad' gt="'value(CurrentMiscName)'" page='ClickTab' refresh')
UCMN = upper(CurrentMiscName)
if (left(UCMN, 11) == 'IMAGECLASS.') | (UCMN == 'GFXAPPPATH') | (UCMN == 'SUNCALCPATH') | (UCMN == 'GFXAPP') then VarReqGad = 0
else VarReqGad = 1
call ToPIPE('CA', 'id 'ChooseValGad' dis='VarReqGad' page='ClickTab' refresh')
return
/**/
/***//*** CA_UpdateGads ***/
CA_UpdateGads:
if show('F', 'ProgReq') == 0 then Req = OpenBusy(PrepReq$, 12)
call ToPIPE('CA', 'id 0 s=256')
FontVarList = ''
ColorVarList = ''
CurrentColor = 0
CalType = 1
Month = CalMonth
EndMonth = 12
EnteredYear = Year
FontReq = 0
MiscVarReq = 0
ColorVarReq = 0
CurrentColorNum = 0
CurrentMiscNum = 0
OverGad = 0
ShiftDown = 0
ShiftedGad = 0
DoBothS = ''
DoBothJ = ''
WarningCount = WarningsSoFar
call ReadData
if UpdateBusy(Req, 1) == -1 then call Cleanup
UCMN = upper(CurrentMiscName)
if UpdateBusy(Req, 1) == -1 then call Cleanup
if DoExtended == 1 then do
DoTopExtraWk = 0
DoTopExtraWkDis = 1
DoNoteBox = 0
DoNoteBoxDis = 1
end
else do
DoTopExtraWkDis = 0
DoNoteBoxDis = 0
end
if (PrefsName == 'Default') & (PrefsFile ~= 'Default') then DisplayName = PrefsFile
else DisplayName = PrefsName
do DSR_Posn = 1 to PosnCount
if (DSR_Posn == PhasesPosn) & (PhaseLib ~= 1) then iterate
if (DSR_Posn == SunrisePosn) & (exists(Storage'suncalc') == 0) then iterate
if (DSR_Posn == SunsetPosn) & (exists(Storage'suncalc') == 0) then iterate
if (DSR_Posn == BothSPosn) & (exists(Storage'suncalc') == 0) then iterate
if (DSR_Posn == RandomPosn) & (exists(ScriptDir'FWCRandom.txt') == 0) then iterate
if (DSR_Posn == HistoryPosn) & (exists(ScriptDir'FWCHistory/01') == 0) then iterate
interpret 'DoVariable = "Do'Do.DSR_Posn'"'
if value(DoVariable) == 0 then interpret DoVariable " = ''"
if value(DoVariable) ~= '' then do
interpret DoVariable' = right(value(DoVariable), 2, "B")'
DSR_Grp = translate(left(value(DoVariable), 1), '02', 'BT') + translate(right(value(DoVariable), 1), '012', 'LCR')
GadSel.DSR_Grp.DSR_Posn = 1
DSR_Sel.DSR_Grp = DSR_Posn
end
end
do DSR_Grp = 0 to GroupCount
if (GadSel.DSR_Grp.SunsetPosn == GadSel.DSR_Grp.SunrisePosn) & (GadSel.DSR_Grp.SunsetPosn == 1) then do
GadSel.DSR_Grp.SunsetPosn = 0
GadSel.DSR_Grp.SunrisePosn = 0
GadSel.DSR_Grp.BothSPosn = 1
DSR_Sel.DSR_Grp = BothSPosn
end
else if (GadSel.DSR_Grp.JulianPosn == GadSel.DSR_Grp.JulianLeftPosn) & (GadSel.DSR_Grp.JulianPosn == 1) then do
GadSel.DSR_Grp.JulianPosn = 0
GadSel.DSR_Grp.JulianLeftPosn = 0
GadSel.DSR_Grp.BothJPosn = 1
DSR_Sel.DSR_Grp = BothJPosn
end
end
do DSR_Grp = 0 to GroupCount
DSR_Posn = DSR_Sel.DSR_Grp
GadSel.DSR_Grp.DSR_Posn = 1
end
if UpdateBusy(Req, 1) == -1 then call Cleanup
call close('MiscVarReq')
call open('MiscVarReq', "awnpipe:MiscVarReq/xc")
call ToPIPE('MiscVarReq', 'm dg v db a ps="'AppScreen'"')
MiscVarListID = ToPIPE('MiscVarReq', 'listbrowser minw=200 minh=300')
do DSR_i = 0 to MiscVarName.Count - 1
GadID = ToPIPE('MiscVarReq', 'browsernode gt="'MiscVarName.DSR_i'"')
interpret 'MiscVarGad.'GadID' = 'DSR_i
end
call UpdateMiscVarGad
call close('ColorVarReq')
call open('ColorVarReq', "awnpipe:ColorVarReq/xc")
call ToPIPE('ColorVarReq', 'm dg v db a ps="'AppScreen'"')
call ToPIPE('ColorVarReq', 'listbrowser minw=200 minh=300')
do DSR_i = 0 to ColorVarName.Count - 1
GadID = ToPIPE('ColorVarReq', 'browsernode gt="'ColorVarName.DSR_i'"')
interpret 'ColorVarGad.'GadID' = 'DSR_i
end
do DSR_i = 0 to FontVarName.Count - 1
FontVarList = FontVarList''FontVarName.DSR_i'|'
end
FontVarList = '"'strip(FontVarList, 'B', '|')'"'
if UpdateBusy(Req, 1) == -1 then call Cleanup
call ToPIPE('CA', 'id 'DisplayNameGad' gt="'DisplayName'" ref')
call ToPIPE('CA', 'id 'MiniCalsGad' s='DoMiniCals' page='ClickTab' ref')
call ToPIPE('CA', 'id 'HighlightsGad' s='DoHighlights' page='ClickTab' ref')
call ToPIPE('CA', 'id 'ImagesGad' dis='GfxDisable' s='DoImages' page='ClickTab' ref')
call ToPIPE('CA', 'id 'BoxDatesGad' s='DoDateBox' page='ClickTab' ref')
call ToPIPE('CA', 'id 'ExtendedGad' s='DoExtended' page='ClickTab' ref')
call ToPIPE('CA', 'id 'TopLongGad' dis='DoTopExtraWkDis' s='DoTopExtraWk' page='ClickTab' ref')
call ToPIPE('CA', 'id 'NoteBoxGad' dis='DoNoteBoxDis' s='DoNoteBox' page='ClickTab' ref')
call ToPIPE('CA', 'id 'TopMargGad' gt="'Margin.Top'" page='ClickTab' ref')
call ToPIPE('CA', 'id 'LeftMargGad' gt="'Margin.Left'" page='ClickTab' ref')
call ToPIPE('CA', 'id 'OrientationGad' s='OrientChoice' page='ClickTab' ref')
call ToPIPE('CA', 'id 'RightMargGad' gt="'Margin.Right'" page='ClickTab' ref')
call ToPIPE('CA', 'id 'BottomMargGad' gt="'Margin.Bottom'" page='ClickTab' ref')
call ToPIPE('CA', 'id 'CalendarTypeGad' s=0 ref')
call AssignID('SwitchGad1', ToPIPE('CA', 'define chooser replace='SwitchGad1' pu cl='MonthList' s='Month - 1))
call AssignID('SwitchGad2', ToPIPE('CA', 'define integer replace='SwitchGad2' a tc weiw=5 maxc=4 defn='EnteredYear))
call AssignID('SwitchGad3', ToPIPE('CA', 'define button replace='SwitchGad3' b=0 gt=""'))
call ToPIPE('CA', 'refresh')
Help$.SwitchGad1Help = Help$.MonthGadHelp
Help$.SwitchGad2Help = Help$.YearGadHelp
Help$.SwitchGad3Help = ''
call ToPIPE('CA', 'id 'SwitchGad1' s='Month - 1' ref')
call ToPIPE('CA', 'id 'SwitchGad2' defn='EnteredYear' ref')
call ToPIPE('CA', 'id 'FontVarGad' defn='FontVarName.COUNT' cl='FontVarList' page='ClickTab' ref')
call ToPIPE('CA', 'id 'FontValGad' gt="'value(CurrentFontName)'" page='ClickTab' ref')
call ToPIPE('CA', 'id 'ColorVarGad' gt="'CurrentColorName'" page='ClickTab' ref')
call ToPIPE('CA', 'id 'ColorValGad' gt="'value(CurrentColorName)'" page='ClickTab' ref')
call ToPIPE('CA', 'id 'MatchColorsGad' s='DoMatchColors' page='ClickTab' ref')
call ToPIPE('CA', 'id 'DailyColorsGad' s='DoDailyColors' page='ClickTab' ref')
call ToPIPE('CA', 'id 'MiscVarGad' gt="'CurrentMiscName'" page='ClickTab' ref')
call ToPIPE('CA', 'id 'MiscValGad' gt="'VarVal'" page='ClickTab' ref')
call ToPIPE('CA', 'id 'ChooseValGad' dis='VarReqGad' page='ClickTab' ref')
if UpdateBusy(Req, 1) == -1 then call Cleanup
do DSR_Grp = 0 to GroupCount
do DSR_Posn = 0 to PosnCount
if datatype(Gad.DSR_Grp.DSR_Posn) == 'NUM' then call ToPIPE('CA', 'id 'Gad.DSR_Grp.DSR_Posn' dis='GadDis.DSR_Grp.DSR_Posn' s='GadSel.DSR_Grp.DSR_Posn' page='ClickTab' ref')
end
call ControlMX(DSR_Grp, DSR_Sel.DSR_Grp)
if PhaseLib ~= 1 then call ToPIPE('CA', 'id 'Gad.DSR_Grp.PhasesPosn' dis=1 page='ClickTab' ref')
if (~exists(ScriptDir'FWCRandom.txt')) & (datatype(Gad.DSR_Grp.RandomPosn) == 'NUM') then
call ToPIPE('CA', 'id 'Gad.DSR_Grp.RandomPosn' dis=1 page='ClickTab' ref')
if ~exists(ScriptDir'FWCHistory/01') & (datatype(Gad.DSR_Grp.HistoryPosn) == 'NUM') then
call ToPIPE('CA', 'id 'Gad.DSR_Grp.HistoryPosn' dis=1 page='ClickTab' ref'))
if ~exists(Storage'suncalc') then do
call ToPIPE('CA', 'id 'Gad.DSR_Grp.SunRisePosn' dis=1 page='ClickTab' ref')
call ToPIPE('CA', 'id 'Gad.DSR_Grp.SunSetPosn' dis=1 page='ClickTab' ref')
call ToPIPE('CA', 'id 'Gad.DSR_Grp.BothSPosn' dis=1 page='ClickTab' ref')
end
end
call ToPIPE('CA', 'id 0 s=512')
if UpdateBusy(Req, 1) == -1 then call Cleanup
call close('ProgReq')
return
/**/
/**/
/***//*** dTox (PROCEDURE) ***/
dTox:PROCEDURE
parse arg DecVal
BinVal = ''
HexVal = ''
do i = 32 to 0 by -1
if DecVal >= 2**i then do
BinVal = BinVal'1'
DecVal = DecVal - 2**i
end
else BinVal = BinVal'0'
end
do until BinVal == ''
HexVal = c2x(b2c(right(BinVal, 8, '0')))''HexVal
if length(BinVal) >= 8 then CutLength = 8
else CutLength = length(BinVal)
BinVal = left(BinVal, length(BinVal) - CutLength)
end
return HexVal
/**/
/***//*** DrawBox (DB) ***/
DrawBox:
parse arg DB_x1, DB_y1, DB_width, DB_height, DB_Weight, DB_LineColor, DB_FillBool, DB_FillColor, DB_SendToBack, DB_CornerRadius
if DB_FillColor == '<'Clear$'>' then DB_FillBool = 0
if App == 'FW' then do
if DB_Weight == 'HL' then DB_Weight = 'Hairline'
else if DB_Weight == 0 then do
DB_Weight = 'None'
if DB_FillColor ~= '<'Clear$'>' then DB_LineColor = DB_FillColor
end
if DB_FillBool == 1 then DB_FillBool = 'Solid'
else do
DB_FillBool = 'Transparent'
DB_FillColor = DB_LineColor
end
if DB_CornerRadius == 0 then DB_BoxType = ''
else DB_BoxType = 'BEVEL'
BOXPREFS LINEWT DB_Weight LINECOLOR '"'DB_LineColor'"' FILL DB_FillBool FILLCOLOR '"'DB_FillColor'"'
DRAWBOX 1 DB_x1 DB_y1 DB_width DB_height DB_BoxType; DB_id = result
if DB_SendToBack == 1 then OBJECTTOBACK
end
else if App == 'PGS' then do
if DB_Weight == 'HL' then DB_Weight = 0.3pt
else DB_Weight = DB_Weight'pt'
if DB_FillBool == 1 then DB_FillBool = 'ON'
else DB_FillBool = 'OFF'
If DB_Weight == 0 then DB_LineBool = 'OFF'
else DB_LineBool = 'ON'
if DB_CornerRadius == 0 then DB_BoxType = 'NORMAL'
else DB_BoxType = 'ROUND'
DRAWBOX DB_x1 DB_y1 DB_x1+DB_width DB_y1+DB_height DB_BoxType CORNER DB_CornerRadius WINDOW winName; DB_id = result
STROKED DB_LineBool OBJECT WINDOW winName
SETSTROKEWEIGHT DB_Weight STROKENUMBER 0 OBJECT WINDOW winName
SETCOLORSTYLE '"'DB_LineColor'"' COLORNUMBER 0 STROKENUMBER 0 OBJECT WINDOW winName
FILLED DB_FillBool OBJECT WINDOW winName
SETCOLORSTYLE '"'DB_FillColor'"' COLORNUMBER 0 FILL OBJECT WINDOW winName
if DB_SendToBack == 1 then SENDTOBACK OBJECTID DB_id WINDOW winName
end
return DB_id
/**/
/***//*** DrawHalf (DH) ***/
DrawHalf:
parse arg DH_Side
if App == 'FW' then do
if DH_Side == 'L' then DH_sign = -1
else DH_sign = 1
STARTPATH 1 DM_CtrX (DM_CtrY + MoonRadius)
CURVETO 1 (DM_CtrX + (DH_sign * MoonRadius * BelzierFactor)) (DM_CtrY + MoonRadius) (DM_CtrX + (DH_sign * MoonRadius)) (DM_CtrY + MoonRadius * BelzierFactor) (DM_CtrX + (DH_sign * MoonRadius)) DM_CtrY
CURVETO 1 (DM_CtrX + (DH_sign * MoonRadius)) (DM_CtrY - MoonRadius * BelzierFactor) (DM_CtrX + (DH_sign * MoonRadius * BelzierFactor)) (DM_CtrY - MoonRadius) DM_CtrX (DM_CtrY - MoonRadius)
ENDPATH Close
end
else if App == 'PGS' then do
if DH_Side == 'L' then DRAWELLIPSE DM_CtrX DM_CtrY MoonRadius MoonRadius PIE ANGLES 90 270 WINDOW winName
else DRAWELLIPSE DM_CtrX DM_CtrY MoonRadius MoonRadius PIE ANGLES 270 90 WINDOW winName
end
return result
/**/
/***//*** DrawLine (DL) ***/
DrawLine:
parse arg DL_x1, DL_y1, DL_x2, DL_y2, DL_Weight, DL_Color
if App == 'FW' then do
if DL_Weight == 'HL' then DL_Weight = 'Hairline'
else if DL_Weight == 0 then DL_Weight = 'None'
LINEPREFS LINEWT DL_Weight LINECOLOR '"'DL_Color'"'
DRAWLINE 1 DL_x1 DL_y1 DL_x2 DL_y2
end
else if App == 'PGS' then do
if DL_Weight == 'HL' then DL_Weight = '0.3pt'
else DL_Weight = DL_Weight'pt'
DRAWLINE DL_x1 DL_y1 DL_x2 DL_y2 WINDOW winName; DL_id = result
STROKED ON OBJECT WINDOW winName
SETSTROKEWEIGHT DL_Weight STROKENUMBER 0 OBJECT
SETCOLORSTYLE '"'DL_Color'"' COLORNUMBER 0 STROKENUMBER 0 OBJECT WINDOW winName
end
return result
/**/
/***//*** DrawMiniCal (DMC) ***/
DrawMiniCal:
parse arg DMC_MiniDirection, DMC_CalWidth, DMC_FontType
DMC_ColumnWidth = DMC_CalWidth/8
DMC_BoxCount = 0
DMC_MiniMonth = Month + DMC_MiniDirection
if DMC_MiniMonth == 0 | DMC_MiniMonth == 13 then do
DMC_MiniMonth = abs(DMC_MiniMonth - 12)
Year = EnteredYear + DMC_MiniDirection
end
else Year = EnteredYear
Mn = right(DMC_MiniMonth, 2, '0')
if DoHighlights == 1 then call SetHighlights
if DMC_MiniDirection < 0 then do
DMC_StartColumn = StartDate - MonthLength.DMC_MiniMonth//7
If DMC_StartColumn < 0 then DMC_StartColumn = DMC_StartColumn + 7
DMC_MiniCalLeft = Margin.Left + ShiftLMini - CalendarBorder
end
else if DMC_MiniDirection > 0 then do
DMC_StartColumn = StartDate + MonthLength.Month//7
If DMC_StartColumn > 6 then DMC_StartColumn = DMC_StartColumn - 7
DMC_MiniCalLeft = FullWidth - Margin.Right - DMC_CalWidth + ShiftRMini - CalendarShadow
end
else do
DMC_StartColumn = StartDate
DMC_MiniCalLeft = Margin.Left + c * (DMC_CalWidth + MiniCalSpacing)
end
/* Print Month & Year */
DMC_ID.0 = CenterText(PrintText(1, Margin.Top, DMC_FontType, 'N', Color.MiniCal, Width.DMC_FontType, Month.DMC_MiniMonth' 'Year), DMC_MiniCalLeft + DMC_CalWidth/2, DMC_CalWidth, 0)
/* Print Days */
DMC_Column = DMC_StartColumn
DMC_Day = 0
DMC_Row = 1
Do Until DMC_Day = MonthLength.DMC_MiniMonth
DMC_Day = DMC_Day + 1
DMC_Char1 = left(right(DMC_Day, 2, ' '), 1)
DMC_Char2 = right(DMC_Day, 1)
if (Highlight.DMC_MiniMonth.DMC_Day == '') | (symbol('Highlight.DMC_MiniMonth.DMC_Day') == 'LIT') then do
DMC_Style = 'N'
if CenterMiniDates == 1 then DMC_CenterAdj = (DMC_ColumnWidth - 2*NormalWidth.Widest)/2 + (NormalWidth.Widest * 2 - NormalWidth.DMC_Char1 - NormalWidth.DMC_Char2) / 2 + NormalWidth.DMC_Char1 + NormalWidth.DMC_Char2
else DMC_CenterAdj = (DMC_ColumnWidth - 2*NormalWidth.Widest)/2 + (NormalWidth.Widest - NormalWidth.DMC_Char2) / 2 + NormalWidth.DMC_Char1 + NormalWidth.DMC_Char2
end
else do
DMC_Style = 'B'
if CenterMiniDates == 1 then DMC_CenterAdj = (DMC_ColumnWidth - 2*BoldWidth.Widest)/2 + (BoldWidth.Widest * 2 - BoldWidth.DMC_Char1 - BoldWidth.DMC_Char2) / 2 + BoldWidth.DMC_Char1 + BoldWidth.DMC_Char2
else DMC_CenterAdj = (DMC_ColumnWidth - 2*BoldWidth.Widest)/2 + (BoldWidth.Widest - BoldWidth.DMC_Char2) / 2 + BoldWidth.DMC_Char1 + BoldWidth.DMC_Char2
end
DMC_Text.Right = (DMC_Column + 1.5) * DMC_ColumnWidth
DMC_Text.Top = Margin.Top + DMC_Row*Height.DMC_FontType
DMC_Text.Left = DMC_MiniCalLeft + DMC_Text.Right - DMC_CenterAdj
DMC_ID.DMC_Day = PrintText(DMC_Text.Left, DMC_Text.Top, DMC_FontType, DMC_Style, Color.MiniCal, Width.DMC_FontType, DMC_Day)
if UpdateBusy(Req, 1) == -1 then call Cleanup
if pos('#', Highlight.DMC_MiniMonth.DMC_Day) > 0 then do
DMC_BoxCount = DMC_BoxCount + 1
DMC_Box.Left = DMC_MiniCalLeft + (DMC_Column + .5) * DMC_ColumnWidth
DMC_BoxID.DMC_BoxCount = DrawBox(DMC_Box.Left, DMC_Text.Top - (Height.DMC_FontType * ((1 - TextAdj) / 3) * (App == 'FW')), DMC_ColumnWidth, Height.DMC_FontType, 'HL', Line.MiniCal, 0, Black$, 1, 0)
call BuryObject(DMC_BoxID.DMC_BoxCount)
end
DMC_Column = DMC_Column + 1
if DMC_Column == 7 then do
DMC_Column = 0
DMC_Row = DMC_Row + 1
end
end
if CalendarShadow ~= 0 then do
if ShadowType == 'P' then do
call DrawBox(DMC_MiniCalLeft + DMC_CalWidth, Margin.Top + CalendarShadow, CalendarShadow, 7*Height.DMC_FontType, 0, , 1, Background.MiniCalShadow, 1, 0)
call DrawBox(DMC_MiniCalLeft + CalendarShadow, Margin.Top + 7*Height.DMC_FontType, DMC_CalWidth, CalendarShadow, 0, , 1, Background.MiniCalShadow, 1, 0)
end
else call DrawBox(DMC_MiniCalLeft + CalendarShadow, Margin.Top + CalendarShadow, DMC_CalWidth, 7*Height.DMC_FontType, 0, , 1, Background.MiniCalShadow, 1, CornerRadius * MiniCalWidth)
end
call DrawBox(DMC_MiniCalLeft, Margin.Top, DMC_CalWidth, 7*Height.DMC_FontType, 'HL', Line.MiniCal, 1, Background.MiniCal, 1, CornerRadius * MiniCalWidth)
if UpdateBusy(Req, 1) == -1 then call Cleanup
if App == 'FW' then do
REDRAW
do DMC_i = 0 to MonthLength.DMC_MiniMonth; SELECTOBJECT DMC_ID.DMC_i MULTIPLE; End
do DMC_i = 1 to DMC_BoxCount; SELECTOBJECT DMC_BoxID.DMC_i MULTIPLE; End
GROUP
end
else if App == 'PGS' then do
do DMC_i = 0 to MonthLength.DMC_MiniMonth; SELECTOBJECT ObjectID DMC_ID.DMC_i Add WINDOW winName; End
do DMC_i = 1 to DMC_BoxCount; SELECTOBJECT ObjectID DMC_BoxID.DMC_i Add WINDOW winName; End
GROUP WINDOW winName
end
return
/**/
/***//*** DrawMoon (DM) ***/
DrawMoon:
parse arg DM_Phase, DM_CtrX, DM_CtrY, DM_Color
if App == 'FW' then do
if (DM_Phase == 'N') | (DM_Phase == 'F') then do
if DM_Phase == 'N' then DM_FillColor = DM_Color
else DM_FillColor = White$
OVALPREFS LINEWT 'Hairline' LINECOLOR '"'DM_Color'"' FILL 'Solid' FILLCOLOR '"'DM_FillColor'"'
DRAWOVAL 1 (DM_CtrX - MoonRadius) (DM_CtrY - MoonRadius) (2 * MoonRadius) (2 * MoonRadius)
DM_id = result
end
else do
SHAPEPREFS LINEWT 'Hairline' LINECOLOR '"'DM_Color'"' FILL 'Solid' FILLCOLOR '"'DM_Color'"'
if DM_Phase == 1 then DM_HalfID = DrawHalf('R')
else DM_HalfID = DrawHalf('L')
SHAPEPREFS FILLCOLOR '"'White$'"'
if DM_Phase == 1 then DM_Half2ID = DrawHalf('L')
else DM_Half2ID = DrawHalf('R')
SELECTOBJECT DM_HalfID
SELECTOBJECT DM_Half2ID Multiple
GROUP
CURRENTOBJECT; DM_id = result
end
end
else if App == 'PGS' then do
if (DM_Phase == 'N') | (DM_Phase == 'F') then do
DRAWELLIPSE DM_CtrX DM_CtrY MoonRadius MoonRadius WINDOW winName
DM_id = result
if DM_Phase == 'N' then call SetFill(DM_id, DM_Color, DM_Color)
else call SetFill(DM_id, DM_Color, White$)
end
else do
DRAWELLIPSE DM_CtrX DM_CtrY MoonRadius MoonRadius PIE ANGLES 90 270 WINDOW winName
DM_LHalfID = result
if DM_Phase == 1 then call SetFill(DM_LHalfID, DM_Color, White$)
else call SetFill(DM_LHalfID, DM_Color, DM_Color)
DRAWELLIPSE DM_CtrX DM_CtrY MoonRadius MoonRadius PIE ANGLES 270 90 WINDOW winName
DM_RHalfID = result
if DM_Phase == 1 then call SetFill(DM_RHalfID, DM_Color, DM_Color)
else call SetFill(DM_RHalfID, DM_Color, White$)
SELECTOBJECT OBJECTID DM_LHalfID Add WINDOW winName
GROUP WINDOW winName; DM_id = result
end
end
return DM_id
/**/
/***//*** EditHighlight ***/
/***//*** EditHighlight_BGUI (EH) ***/
EditHighlight_BGUI:
/***//*** Initialize Variables ***/
EH_WeekendCyc.0 = "OK"
EH_WeekendCyc.1 = "P"
EH_WeekendCyc.2 = "N"
EH_WeekendCyc.OK = 0
EH_WeekendCyc.P = 1
EH_WeekendCyc.N = 2
EH_WeekTypeCyc.0 = "All"
EH_WeekTypeCyc.1 = "Odd"
EH_WeekTypeCyc.2 = "Even"
EH_WeekTypeCyc.All = 0
EH_WeekTypeCyc.Odd = 1
EH_WeekTypeCyc.Even = 2
EH_HighlightTypeCyc.Fixed = 0
EH_HighlightTypeCyc.Float = 1
EH_HighlightTypeCyc.BiOrWeekly = 2
EH_HighlightTypeCyc.0 = 'Fixed'
EH_HighlightTypeCyc.1 = 'Float'
EH_HighlightTypeCyc.2 = 'BiOrWeekly'
EH_KeywordCode.00 = 'Highlight'
EH_KeywordCode.01 = 'Image'
EH_KeywordCode.10 = 'CalculateDate'
EH_KeywordCode.11 = 'CalculateImage'
EH_KeywordCode.20 = 'CalculateDate'
EH_KeywordCode.21 = 'CalculateImage'
EH_EntryCount = 0
EH_EventDay = 0
EH_Year = left(date('S'),4)
interpret 'EH_StartYear = Day.'DateInfo('W', EH_Year'0101', 'S')
EH_YearOffset = 7 - EH_StartYear
if EH_YearOffset == 7 then EH_YearOffset = 0
EH_SelectMonth = right(EH_SelectMonth, 2, '0')
EH_MonthCount = MonthCount.EH_SelectMonth
EH_Month = EH_SelectMonth - 0
if EH_Month > 12 then EH_Month = 1
EH_Month = right(EH_Month, 2, "0")
EH_ShortMonth = EH_Month - 0
interpret 'EH_StartDate = Day.'DateInfo('W', EH_Year''EH_Month'01', 'S')
/**/
/***//*** EH_ReadData ***/
/* Read data here */
if EH_MonthCount > 0 then do
do EH_j = 1 to EH_MonthCount
EH_EntryCount = EH_EntryCount + 1
if EH_SelectMonth < 14 then CurrentData.EH_SelectMonth.EH_j = substr(HighlightData.EH_SelectMonth.EH_j, 3)
else CurrentData.EH_SelectMonth.EH_j = HighlightData.EH_SelectMonth.EH_j
if symbol('CurrentData.EH_SelectMonth.EH_j') == 'VAR' then do
EH_HighlightData = strip(CurrentData.EH_SelectMonth.EH_j)
if right(EH_HighlightData, 2) == '*/' then do
EH_StartComment = lastpos('/*', EH_HighlightData)
EH_Comment.EH_EntryCount = strip(substr(EH_HighlightData, EH_StartComment), 'B', ' /*')
EH_HighlightData = strip(left(EH_HighlightData, EH_StartComment - 1))
end
else EH_Comment.EH_EntryCount = ''
EH_Keyword = word(EH_HighlightData, 1)
EH_FirstDot = pos('.', EH_Keyword)
EH_FirstParen = pos('(', EH_Keyword)
if EH_FirstDot == 0 then EH_EndOfKeyword = EH_FirstParen
else if EH_FirstParen == 0 then EH_EndOfKeyword = EH_FirstDot
else EH_EndOfKeyword = min(pos('.', EH_Keyword), pos('(', EH_Keyword))
EH_Keyword.EH_EntryCount = left(EH_Keyword, EH_EndOfKeyword - 1)
if (upper(EH_Keyword.EH_EntryCount) == 'HIGHLIGHT') | (upper(EH_Keyword.EH_EntryCount) == 'IMAGE') then do
EH_HighlightType.EH_EntryCount = 'Fixed'
EH_EventDay.EH_EntryCount = substr(EH_Keyword, lastpos('.', EH_Keyword) + 1)
EH_Event.EH_EntryCount = substr(EH_HighlightData, pos('=', EH_HighlightData) + 1)
parse var EH_Event.EH_EntryCount EH_Event.EH_EntryCount','EH_Color.EH_EntryCount
if upper(EH_Keyword.EH_EntryCount) == 'IMAGE' then do
if (pos(':', EH_Event.EH_EntryCount) == 0) & (pos('/', EH_Event.EH_EntryCount) == 0) then
EH_Event.EH_EntryCount = ScriptDir'Images/'strip(EH_Event.EH_EntryCount, 'B', ' "'||"'")
end
end
else do
EH_HighlightData = strip(substr(EH_HighlightData, EH_EndOfKeyword + 1), 'B', ')')
if EH_SelectMonth == 14 then do
parse var EH_HighlightData EH_EventDay.EH_EntryCount','EH_Event.EH_EntryCount','EH_Color.EH_EntryCount
EH_EventDay.EH_EntryCount = strip(EH_EventDay.EH_EntryCount)
EH_Event.EH_EntryCount = strip(EH_Event.EH_EntryCount)
EH_HighlightType.EH_EntryCount = 'Easter'
EH_Keyword.EH_EntryCount = 'CalculateEDate'
end
else do
parse var EH_HighlightData .','EH_DayOfWeek','EH_HighDate','EH_Event.EH_EntryCount','EH_Color.EH_EntryCount
interpret "EH_DayOfWeek = Day."strip(EH_DayOfWeek, 'B', ' "'||"'")
EH_HighDate = strip(EH_HighDate)
EH_Event.EH_EntryCount = strip(EH_Event.EH_EntryCount)
if pos('IMAGE', upper(EH_Keyword.EH_EntryCount)) > 0 then do
if (pos(':', EH_Event.EH_EntryCount) == 0) & (pos('/', EH_Event.EH_EntryCount) == 0) then do
EH_Event.EH_EntryCount = ScriptDir'Images/'strip(EH_Event.EH_EntryCount, 'B', ' "'||"'")
end
end
if datatype(EH_HighDate) == 'CHAR' then do
/* Weekly/Biweekly events */
EH_HighlightType.EH_EntryCount = 'BiOrWeekly'
EH_WeekType.EH_EntryCount = strip(upper(EH_HighDate), 'B', "'")
EH_EventOffset = EH_DayOfWeek - EH_StartDate
EH_EventDay.EH_EntryCount = 1 + EH_EventOffset
if EH_EventDay.EH_EntryCount < 1 then EH_EventDay.EH_EntryCount = EH_EventDay.EH_EntryCount + 7
EH_WN = trunc((right(DateInfo('J', EH_Year''EH_Month''right(EH_EventDay.EH_EntryCount, 2, '0'), 'S'), 3) - EH_YearOffset - 1)/7 + 1)
if ((EH_WeekType.EH_EntryCount == 'EVEN') & (EH_WN//2 == 1)) | ((EH_WeekType.EH_EntryCount == 'ODD') & (EH_WN//2 == 0)) then EH_EventDay.EH_EntryCount = EH_EventDay.EH_EntryCount + 7
end
else do
EH_HighlightType.EH_EntryCount = 'Float'
interpret 'EH_First = Day.'DateInfo('W', EH_Year''EH_Month'01', 'S')
EH_EventDay.EH_EntryCount = EH_HighDate + (EH_DayOfWeek - EH_First)
if EH_First < EH_DayOfWeek then EH_EventDay.EH_EntryCount = EH_EventDay.EH_EntryCount - 7
EH_TempDay = EH_EventDay.EH_EntryCount
EH_Weeknumber.EH_EntryCount = 0
if EH_HighDate > 28 then EH_Weeknumber.EH_EntryCount = 4
else do
do until EH_TempDay < 0
EH_TempDay = EH_TempDay - 7
if EH_TempDay > 0 then EH_Weeknumber.EH_EntryCount = EH_Weeknumber.EH_EntryCount + 1
end
end
end
end
end
if datatype(EH_EventDay.EH_EntryCount) == 'CHAR' then do
EH_Weekend.EH_EntryCount = upper(right(EH_EventDay.EH_EntryCount, 1))
EH_EventDay.EH_EntryCount = left(EH_EventDay.EH_EntryCount, length(EH_EventDay.EH_EntryCount) - 1)
end
else EH_Weekend.EH_EntryCount = 'OK'
if EH_EventDay.EH_EntryCount == '32' then EH_EventDay.EH_EntryCount = 'LD'
EH_Event.EH_EntryCount = strip(EH_Event.EH_EntryCount, 'B', ' "'||"'")
if right(EH_Event.EH_EntryCount, 1) == '#' then do
EH_Holiday.EH_EntryCount = 128
EH_Event.EH_EntryCount = left(EH_Event.EH_EntryCount, length(EH_Event.EH_EntryCount) - 1)
end
else EH_Holiday.EH_EntryCount = 0
end
EH_Color.EH_EntryCount = strip(EH_Color.EH_EntryCount, 'B', ' "'||"'")
EH_Color.EH_EntryCount = MemberID(EH_Color.EH_EntryCount, 'ColorList')
if EH_Color.EH_EntryCount == -1 then EH_Color.EH_EntryCount = ColorList.COUNT
do EH_k = 1 to EH_EntryCount - 1
EH_Seq = EH_Pointer.EH_k
if EH_EventDay.EH_EntryCount < EH_EventDay.EH_Seq then do
do EH_l = EH_EntryCount - 1 to EH_k by -1
EH_Next = EH_l + 1
EH_Pointer.EH_Next = EH_Pointer.EH_l
end
leave
end
end
EH_Pointer.EH_k = EH_EntryCount
end
end
EH_HighEntry = EH_EntryCount
if EH_EntryCount > 0 then do
EH_CurrentPointer = 1
EH_CurrentEntry = EH_Pointer.EH_CurrentPointer
end
else do
EH_CurrentEntry = 0
EH_CurrentPointer = 0
end
EH_DayShowing = 0
/**/
/***//*** GUI Description ***/
GadID. = ''
EH_Arg. = ''
EH_i = 0
EH_Day = 0
Req = OpenBusy(PrepReq$, 45)
do while (EH_i < 6)
EH_j = 0
do while (EH_j < 7)
if UpdateBusy(Req, 1) == -1 then call Cleanup
EH_SerialPosition = (EH_i * 7) + EH_j
EH_Button = EH_SerialPosition + 1
if (EH_SerialPosition >= EH_StartDate) & (EH_SerialPosition < EH_StartDate + MonthLength.EH_ShortMonth + 1) then Do
EH_Day = EH_Day + 1
if EH_Day > MonthLength.EH_ShortMonth then EH_Day = LD
interpret "GadID."EH_Button" = bguitoggle('"EH_Button"_', EH_Day)"
GadID = GetID(EH_Button'_')
EH_Button.EH_Button = GadID
EH_Arg.GadID = EH_Day
EH_ButtonID.EH_Day = EH_Button
end
else do
interpret "GadID."EH_Button" = bguibutton('"EH_Button"_', '')"
GadID = GetID(EH_Button'_')
EH_Button.EH_Button = GadID
EH_Arg.GadID = 'dummy'
end
EH_j = EH_j + 1
end
EH_i = EH_i + 1
if EH_SerialPosition >= EH_StartDate + MonthLength.EH_ShortMonth then leave
end
DateButtons = bguihgroup(GadID.1""GadID.2""GadID.3""GadID.4""GadID.5""GadID.6""GadID.7)||,
bguihgroup(GadID.8""GadID.9""GadID.10""GadID.11""GadID.12""GadID.13""GadID.14)||,
bguihgroup(GadID.15""GadID.16""GadID.17""GadID.18""GadID.19""GadID.20""GadID.21)||,
bguihgroup(GadID.22""GadID.23""GadID.24""GadID.25""GadID.26""GadID.27""GadID.28)
if EH_i > 4 then DateButtons = DateButtons''bguihgroup(GadID.29""GadID.30""GadID.31""GadID.32""GadID.33""GadID.34""GadID.35)
if EH_i > 5 then DateButtons = DateButtons''bguihgroup(GadID.36""GadID.37""GadID.38""GadID.39""GadID.40""GadID.41""GadID.42)
call bguilist("EH_monthlist_", January$, February$, March$, April$, May$, June$, July$, August$, September$, October$, November$, December$, All$, Easter$)
call bguilist("EH_highlighttypelist_", Fixed$, Floating$, BiOrWeekly$)
call bguilist("EH_weeknumberlist_", First$, Second$, Third$, Fourth$, Last$)
call bguilist("EH_weektypelist_", All$, Odd$, Even$)
call bguilist("EH_weekendlist_", OK2$, PreviousDay$, NextDay$)
EH_g=bguivgroup(,
bguihgroup(,
bguistring("EH_event_",Event$":","",256)bguilayout(LGO_FixMinHeight,1)||,
bguiibutton('EH_eventimage_','B','F')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight, 1)||,
bguibutton('EH_prev_','<')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight, 1)||,
bguibutton("EH_next_",'>')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight,1),
)||,
bguihgroup(,
bguistring('EH_comment_',Comment$":","",256)bguilayout(LGO_FixMinHeight,1),
)||,
bguihgroup(,
bguivgroup(,
bguihgroup(,
bguivarspace(40)||,
bguicycle('changemonth_',,"EH_monthlist_",'P')bguilayout(LGO_FixMinHeight, 1)||,
bguivarspace(40),
)||,
bguihgroup(,
bguiinfo("EH_dummy_",,esc"c"left(Day.0,1))||,
bguiinfo("EH_dummy_",,esc"c"left(Day.1,1))||,
bguiinfo("EH_dummy_",,esc"c"left(Day.2,1))||,
bguiinfo("EH_dummy_",,esc"c"left(Day.3,1))||,
bguiinfo("EH_dummy_",,esc"c"left(Day.4,1))||,
bguiinfo("EH_dummy_",,esc"c"left(Day.5,1))||,
bguiinfo("EH_dummy_",,esc"c"left(Day.6,1)),
)||,
DateButtons,
)||,
bguivgroup(,
bguivarspace(40)||,
bguicycle('EH_highlightcolor_',esc"r"Color$':','ColorList','P')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight, 1)||,
bguicycle('EH_highlighttype_',esc"r"Type$':','EH_highlighttypelist_','P')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight, 1)||,
bguicycle("EH_weeknumber_",esc"r"WeekNumber$':',"EH_weeknumberlist_",'P')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight,1)||,
bguicycle('EH_weektype_',esc"r"WeekType$":",'EH_weektypelist_','P')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight, 1)||,
bguicycle("EH_weekend_",esc"r"Weekend$":",'EH_weekendlist_','P')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight,1)||,
bguicheckbox("EH_holiday_",esc"r"Holiday$":",0)bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight,1)||,
bguihgroup(,
bguistring("EH_easter_",Easter$':',,4)bguilayout(LGO_FixMinHeight,1)||,
bguivarspace(40),
)||,
bguihgroup(,
bguibutton("EH_new_",AddEvent$)bguilayout(LGO_FixMinHeight,1)||,
bguibutton("EH_delete_",DeleteEvent$)bguilayout(LGO_FixMinHeight,1),
)||,
bguihgroup(,
bguibutton("EH_done_",Done$)bguilayout(LGO_FixMinHeight,1),
),
),
),
,"-1","-1")
if UpdateBusy(Req, 1) == -1 then call Cleanup
EH_winID=bguiwindow(EnterEventInfo$,EH_g,5,0,,AppScreen)
if UpdateBusy(Req, 1) == -1 then call Cleanup
call bguiwintabcycleorder(EH_winID,obj.EH_event_||obj.EH_comment_)
if EH_EntryCount == 0 then call EH_GhostGads
else if EH_SelectMonth == 14 then do
call EH_GhostGads
call EH_SetGads
end
else do
do EH_i = 1 to EH_Button
EH_temp = EH_Button.EH_i
if EH_Arg.EH_temp == 'dummy' then interpret "call bguiset(obj."EH_i"_,EH_winID, GA_Disabled, 1)"
end
end
call bguiset(obj.changemonth_,EH_winID,CYC_Active,EH_SelectMonth - 1)
/**/
/***//*** GUI Action Loop ***/
EH_CurrentEntry = EH_Pointer.EH_CurrentPointer
call EH_SetRequester
if EH_EntryCount > 0 then EH_DayShowing = EH_EventDay.EH_CurrentEntry
if bguiwinopen(EH_winID)=0 then bguierror(12)
call CloseBusy(Req)
id=0
EH_Done = 0
do until EH_Done ~= 0
call bguiwinwaitevent(EH_winID,"ID")
select
/***//*** Close ***/
when (id == id.EH_cancel_) | (id == id.winclose) then do
call bguiwinclose(EH_winID)
EH_Done = 1
end
/**/
/***//*** Done ***/
when id == id.EH_done_ then do
call EH_ReadSettings
call EH_SaveHighlightData
call bguiwinclose(EH_winID)
EH_Done = 1
end
/**/
/***//*** EH_EventGad ***/
when id == id.EH_event_ then EH_Event.EH_CurrentEntry = bguiget(obj.EH_event_, STRINGA_TextVal)
/**/
/***//*** EH_PrevGad ***/
when id == id.EH_prev_ then do
call EH_ReadSettings
EH_CurrentPointer = EH_CurrentPointer - 1
EH_CurrentEntry = EH_Pointer.EH_CurrentPointer
call EH_SetRequester
EH_DayShowing = EH_EventDay.EH_CurrentEntry
end
/**/
/***//*** EH_NextGad ***/
when id == id.EH_next_ then do
call EH_ReadSettings
EH_CurrentPointer = EH_CurrentPointer + 1
EH_CurrentEntry = EH_Pointer.EH_CurrentPointer
call EH_SetRequester
EH_DayShowing = EH_EventDay.EH_CurrentEntry
end
/**/
/***//*** EH_EventImageGad ***/
when id == id.EH_eventimage_ then do
EH_Dir = CheckDir(ScriptDir'Images/')
if EH_Dir == '' then EH_Dir = ScriptDir
EH_DataFile = bguifilereq(EH_Dir, SelectImage$, EH_winID)
if (EH_DataFile ~= '') & (exists(EH_DataFile) == 1) then call bguiset(obj.EH_event_, EH_winID, STRINGA_TextVal,EH_DataFile)
else do
if EH_DataFile ~= '' then call bguireq(EH_DataFile' 'CantFind$'...','*'OK$,'FWCalendar 'Notice$,EH_winID)
EH_DataFile = ''
end
end
/**/
/***//*** EH_ChangeMontGad ***/
when id == id.changemonth_ then do
call EH_ReadSettings
call EH_SaveHighlightData
call bguiwinclose(EH_winID)
EH_SelectMonth = bguiget(obj.changemonth_,CYC_Active) + 1
call bguiwinclose(EH_winID)
EH_Done = 2
end
/**/
/***//*** EH_HighlightTypeGad ***/
when id == id.EH_highlighttype_ then do
EH_HighlightType = bguiget(obj.EH_highlighttype_,CYC_Active)
EH_HighlightType.CurrentEntry = EH_HighlightTypeCyc.EH_HighlightType
select
when EH_HighlightType.CurrentEntry == 'Fixed' then call EH_SetFixed
when EH_HighlightType.CurrentEntry == 'Float' then do
call EH_SetFloat
call EH_CheckWeekNumber
end
when EH_HighlightType.CurrentEntry == 'BiOrWeekly' then do
call EH_SetBiOrWeekly
call EH_CheckWeekType
end
end
end
/**/
/***//*** EH_WeekNumberGad ***/
when id == id.EH_weeknumber_ then do
if EH_EventDay.EH_CurrentEntry > 0 then do
EH_GadgetID = EH_ButtonID.EH_DayShowing
interpret "call bguiset(obj."EH_GadgetID"_,EH_winID, GA_Selected, 0)"
EH_EventDay = EH_EventDay.EH_CurrentEntry
EH_Weeknumber.EH_CurrentEntry = bguiget(obj.EH_weeknumber_,CYC_Active)
do until EH_EventDay < 1
EH_EventDay = EH_EventDay - 7
end
do EH_i = 0 to EH_Weeknumber.EH_CurrentEntry
EH_EventDay = EH_EventDay + 7
end
if EH_EventDay > MonthLength.EH_ShortMonth then EH_EventDay = EH_EventDay - 7
EH_GadgetID = EH_ButtonID.EH_EventDay
interpret "call bguiset(obj."EH_GadgetID"_,EH_winID, GA_Selected, 1)"
EH_EventDay.EH_CurrentEntry = EH_EventDay
EH_DayShowing = EH_EventDay
end
end
/**/
/***//*** EH_WeekTypeGad ***/
when id == id.EH_weektype_ then do
if EH_EventDay.EH_CurrentEntry > 0 then do
EH_GadgetID = EH_ButtonID.EH_DayShowing
interpret "call bguiset(obj."EH_GadgetID"_,EH_winID, GA_Selected, 0)"
EH_EventDay = EH_EventDay.EH_CurrentEntry
EH_TempWeek = bguiget(obj.EH_weektype_,CYC_Active)
if (EH_TempWeek ~= 0) & (EH_Week ~= EH_TempWeek) then do
if EH_EventDay - 7 < 1 then EH_EventDay = EH_EventDay + 7
else EH_EventDay = EH_EventDay - 7
end
EH_GadgetID = EH_ButtonID.EH_EventDay
interpret "call bguiset(obj."EH_GadgetID"_,EH_winID, GA_Selected, 1)"
EH_EventDay.EH_CurrentEntry = EH_EventDay
EH_DayShowing = EH_EventDay
EH_Week = EH_TempWeek
end
end
/**/
/***//*** EH_NewGad ***/
when id == id.EH_new_ then do
call EH_ReadSettings
if EH_DayShowing ~= 0 then do
EH_GadgetID = EH_ButtonID.EH_DayShowing
interpret "call bguiset(obj."EH_GadgetID"_,EH_winID, GA_Selected, 0)"
end
EH_EntryCount = EH_EntryCount + 1
EH_CurrentPointer = EH_EntryCount
EH_HighEntry = EH_HighEntry + 1
EH_Pointer.EH_CurrentPointer = EH_HighEntry
EH_CurrentEntry = EH_HighEntry
call EH_CreateEntry
call EH_SetGads
call EH_SetRequester
end
/**/
/***//*** EH_DeleteGad ***/
when id == id.EH_delete_ then do
call EH_ReadSettings
if EH_EntryCount == 1 then do
EH_CurrentEntry = 0
EH_CurrentPointer = 0
EH_EntryCount = 0
end
else do
do EH_i = EH_CurrentPointer to EH_EntryCount - 1
EH_NextPointer = EH_i + 1
EH_Pointer.EH_i = EH_Pointer.EH_NextPointer
end
EH_EntryCount = EH_EntryCount - 1
EH_CurrentPointer = min(EH_CurrentPointer, EH_EntryCount)
EH_CurrentEntry = EH_Pointer.EH_CurrentPointer
end
call EH_SetRequester
EH_DayShowing = EH_EventDay.EH_CurrentEntry
end
/**/
/***//*** EH_DateButtons ***/
when (datatype(EH_Arg.id) == 'NUM') | (EH_Arg.id == 'LD') then do
if EH_Arg.id == EH_DayShowing then do
/* Re-set current date button */
EH_GadgetID = EH_ButtonID.EH_DayShowing
interpret "call bguiset(obj."EH_GadgetID"_,EH_winID, GA_Selected, 1)"
end
else do
/* Clear previous date button if necessary */
if EH_DayShowing ~= 0 then do
EH_GadgetID = EH_ButtonID.EH_DayShowing
interpret "call bguiset(obj."EH_GadgetID"_,EH_winID, GA_Selected, 0)"
end
/* Set current date button */
EH_DayShowing = EH_Arg.id
EH_GadgetID = EH_ButtonID.EH_DayShowing
interpret "call bguiset(obj."EH_GadgetID"_,EH_winID, GA_Selected, 1)"
EH_EventDay.EH_CurrentEntry = EH_Arg.id
/* Check for impacts of change */
if EH_HighlightType.CurrentEntry == 'Float' then call EH_CheckWeekNumber
else if EH_HighlightType.CurrentEntry == 'BiOrWeekly' then call EH_CheckWeekType
end
end
/**/
otherwise nop
end
end
return EH_Done
/**/
/***//*** EH_CheckWeekNumber *********/
EH_CheckWeekNumber:
EH_TempDay = EH_EventDay.EH_CurrentEntry
EH_Weeknumber.EH_CurrentEntry = 0
do until EH_TempDay < 0
EH_TempDay = EH_TempDay - 7
if EH_TempDay > 0 then EH_Weeknumber.EH_CurrentEntry = EH_Weeknumber.EH_CurrentEntry + 1
end
call bguiset(obj.EH_weeknumber_, EH_winID, CYC_Active, EH_Weeknumber.EH_CurrentEntry)
return
/**/
/***//*** EH_CheckWeekType *********/
EH_CheckWeekType:
interpret 'EH_StartYear = Day.'DateInfo('W', EH_Year'0101', 'S')
EH_YearOffset = 7 - EH_StartYear
if EH_YearOffset == 7 then EH_YearOffset = 0
EH_Week = 2 - (trunc((right(DateInfo('J', EH_Year''EH_Month''right(EH_EventDay.EH_CurrentEntry, 2, '0'), 'S'), 3) - EH_YearOffset - 1)/7 + 1))//2
call bguiset(obj.EH_weektype_, EH_winID, CYC_Active, EH_Week)
return
/**/
/***//*** EH_CreateEntry *********/
EH_CreateEntry:
EH_Event.EH_CurrentEntry = ''
EH_Comment.EH_CurrentEntry = ''
EH_EventDay.EH_CurrentEntry = 1
EH_Holiday.EH_CurrentEntry = 0
EH_Color.EH_CurrentEntry = ColorList.COUNT
if EH_SelectMonth < 14 then do
EH_HighlightType.EH_CurrentEntry = 'Fixed'
EH_Keyword.EH_CurrentEntry = 'Highlight'
EH_Weekend.EH_CurrentEntry = 'OK'
EH_DayShowing = 1
end
return
/**/
/***//*** EH_GhostGads *********/
EH_GhostGads:
do EH_i = 1 to EH_Button
interpret "call bguiset(obj."EH_i"_,EH_winID, GA_Disabled, 1, GA_Selected, 0)"
end
call bguiset(obj.EH_event_,EH_winID,GA_Disabled, 1)
call bguiset(obj.EH_event_, EH_winID, STRINGA_TextVal,'')
call bguiset(obj.EH_comment_,EH_winID,GA_Disabled, 1)
call bguiset(obj.EH_comment_, EH_winID, STRINGA_TextVal,'')
call bguiset(obj.EH_eventimage_,EH_winID,GA_Disabled, 1)
call bguiset(obj.EH_highlightcolor_,EH_winID,GA_Disabled, 1)
call bguiset(obj.EH_highlighttype_,EH_winID,GA_Disabled, 1)
call bguiset(obj.EH_weeknumber_,EH_winID,GA_Disabled, 1)
call bguiset(obj.EH_weektype_,EH_winID,GA_Disabled, 1)
call bguiset(obj.EH_weekend_,EH_winID,GA_Disabled, 1)
call bguiset(obj.EH_holiday_,EH_winID,GA_Disabled, 1)
call bguiset(obj.EH_easter_,EH_winID, GA_Disabled, 1)
call bguiset(obj.EH_easter_, EH_winID, STRINGA_TextVal,'')
call bguiset(obj.EH_delete_,EH_winID, GA_Disabled, 1)
return
/**/
/***//*** EH_ReadSettings *********/
EH_ReadSettings:
EH_Event.EH_CurrentEntry = bguiget(obj.EH_event_, STRINGA_TextVal)
EH_Comment.EH_CurrentEntry = bguiget(obj.EH_comment_, STRINGA_TextVal)
EH_Color.EH_CurrentEntry = bguiget(obj.EH_highlightcolor_, CYC_Active)
parse var EH_Event.EH_CurrentEntry EH_Image','EH_X','EH_Y
if exists(EH_Image) then EH_Image = 1
else EH_Image = 0
if EH_SelectMonth < 14 then do
EH_HighlightType = bguiget(obj.EH_highlighttype_,CYC_Active)
interpret 'EH_HighlightType.EH_CurrentEntry = EH_HighlightTypeCyc.'EH_HighlightType
interpret 'EH_Keyword.EH_CurrentEntry = EH_KeywordCode.'EH_HighlightType''EH_Image
EH_Weeknumber.EH_CurrentEntry = bguiget(obj.EH_weeknumber_,CYC_Active)
interpret 'EH_WeekType.EH_CurrentEntry = EH_WeekTypeCyc.'bguiget(obj.EH_weektype_,CYC_Active)
interpret 'EH_Weekend.EH_CurrentEntry = EH_WeekendCyc.'bguiget(obj.EH_weekend_,CYC_Active)
end
else EH_EventDay.EH_CurrentEntry = bguiget(obj.EH_easter_, STRINGA_TextVal)
EH_Holiday.EH_CurrentEntry = bguiget(obj.EH_holiday_, GA_Selected)
return
/**/
/***//*** EH_SaveHighlightData *********/
EH_SaveHighlightData:
do EH_i = 1 to EH_EntryCount
EH_CurrentPointer = EH_i
EH_CurrentEntry = EH_Pointer.EH_CurrentPointer
EH_EventDay = EH_EventDay.EH_CurrentEntry
interpret 'EH_Color = ColorList.'EH_Color.EH_CurrentEntry
if EH_EventDay == 'LD' then EH_EventDay = 32
if pos('"', EH_Event.EH_CurrentEntry) == 0 then EH_QuoteChar = '"'
else QuoteChar = "'"
if EH_Holiday.EH_CurrentEntry == 128 then EH_Event.EH_CurrentEntry = EH_Event.EH_CurrentEntry'#'
if EH_Weekend.EH_CurrentEntry ~= 'OK' then EH_EventDay = EH_EventDay''EH_Weekend.EH_CurrentEntry
if (upper(EH_Keyword.EH_CurrentEntry) == 'HIGHLIGHT') | (upper(EH_Keyword.EH_CurrentEntry) == 'IMAGE') then do
EH_DataLine = EH_SelectMonth''EH_Keyword.EH_CurrentEntry'.'EH_SelectMonth - 0'.'EH_EventDay' =',
EH_QuoteChar''EH_Event.EH_CurrentEntry''EH_QuoteChar
if upper(EH_Keyword.EH_CurrentEntry) == 'HIGHLIGHT' then EH_DataLine = EH_DataLine ' ,'EH_QuoteChar''EH_Color''EH_QuoteChar
end
else if (upper(EH_Keyword.EH_CurrentEntry) == 'CALCULATEDATE') | (upper(EH_Keyword.EH_CurrentEntry) == 'CALCULATEIMAGE') then do
EH_DayOfWeek = DateInfo('W', EH_Year''EH_Month''right(EH_EventDay.EH_CurrentEntry, 2, '0'), 'S')
if EH_HighlightType.EH_CurrentEntry == 'Float' then do
interpret 'EH_DayNumber = Day.'EH_DayOfWeek
if EH_Weeknumber.EH_CurrentEntry < 4 then do
EH_DayNumber = EH_DayNumber + 1
if EH_DayNumber == 7 then EH_DayNumber = 0
interpret 'EH_DayOfWeek = Day.'EH_DayNumber
EH_EventDay = 7 * (EH_Weeknumber.EH_CurrentEntry + 1)
end
else do
EH_EventDay = Monthlength.EH_ShortMonth
EH_TempDay = Monthlength.EH_ShortMonth - 29
EH_DayNumber = EH_DayNumber - EH_TempDay
if EH_DayNumber < 0 then EH_DayNumber = EH_DayNumber + 7
else if EH_DayNumber > 6 then EH_DayNumber = EH_DayNumber - 7
interpret 'EH_DayOfWeek = Day.'EH_DayNumber
end
end
else EH_EventDay = "'"EH_WeekType.EH_CurrentEntry"'"
EH_DataLine = EH_SelectMonth''EH_Keyword.EH_CurrentEntry'('EH_SelectMonth - 0',"'EH_DayOfWeek'",'EH_EventDay',',
EH_QuoteChar''EH_Event.EH_CurrentEntry''EH_QuoteChar
if upper(EH_Keyword.EH_CurrentEntry) == 'CALCULATEDATE' then EH_DataLine = EH_DataLine ' ,'EH_QuoteChar''EH_Color''EH_QuoteChar
EH_DataLine = EH_DataLine')'
end
else if EH_SelectMonth == 14 then do
EH_DataLine = 'CalculateEDate('EH_EventDay.EH_CurrentEntry',',
EH_QuoteChar''EH_Event.EH_CurrentEntry''EH_QuoteChar',',
EH_QuoteChar''EH_Color''EH_QuoteChar')'
end
if EH_Comment.EH_CurrentEntry ~= '' then EH_DataLine = EH_DataLine' /* 'EH_Comment.EH_CurrentEntry' */'
HighlightData.EH_SelectMonth.EH_i = EH_DataLine
end
MonthCount.EH_SelectMonth = EH_EntryCount
return
/**/
/***//*** EH_SetBiOrWeekly *********/
EH_SetBiOrWeekly:
EH_GadgetID = EH_ButtonID.LD
interpret "call bguiset(obj."EH_GadgetID"_,EH_winID, GA_Disabled, 1)"
if EH_EventDay.EH_CurrentEntry == 'LD' then do
interpret "call bguiset(obj."EH_GadgetID"_,EH_winID, GA_Selected, 0)"
EH_EventDay.EH_CurrentEntry = 1
EH_GadgetID = EH_ButtonID.1
interpret "call bguiset(obj."EH_GadgetID"_,EH_winID, GA_Selected, 1)"
EH_DayShowing = 1
end
call bguiset(obj.EH_weeknumber_,EH_winID,GA_Disabled, 1)
call bguiset(obj.EH_weektype_,EH_winID,GA_Disabled, 0)
call bguiset(obj.EH_weekend_,EH_winID,GA_Disabled, 1)
call bguiset(obj.EH_easter_,EH_winID,GA_Disabled, 1)
return
/**/
/***//*** EH_SetFixed *********/
EH_SetFixed:
EH_GadgetID = EH_ButtonID.LD
interpret "call bguiset(obj."EH_GadgetID"_,EH_winID, GA_Disabled, 0)"
call bguiset(obj.EH_weeknumber_,EH_winID,GA_Disabled, 1)
call bguiset(obj.EH_weektype_,EH_winID,GA_Disabled, 1)
call bguiset(obj.EH_weekend_,EH_winID,GA_Disabled, 0)
call bguiset(obj.EH_easter_,EH_winID,GA_Disabled, 1)
return
/**/
/***//*** EH_SetFloat *********/
EH_SetFloat:
EH_GadgetID = EH_ButtonID.LD
interpret "call bguiset(obj."EH_GadgetID"_,EH_winID, GA_Disabled, 1)"
if EH_EventDay.EH_CurrentEntry == 'LD' then do
interpret "call bguiset(obj."EH_GadgetID"_,EH_winID, GA_Selected, 0)"
EH_EventDay.EH_CurrentEntry = 1
EH_GadgetID = EH_ButtonID.1
interpret "call bguiset(obj."EH_GadgetID"_,EH_winID, GA_Selected, 1)"
EH_DayShowing = 1
end
call bguiset(obj.EH_weeknumber_,EH_winID,GA_Disabled, 0)
call bguiset(obj.EH_weektype_,EH_winID,GA_Disabled, 1)
call bguiset(obj.EH_weekend_,EH_winID,GA_Disabled, 1)
call bguiset(obj.EH_easter_,EH_winID,GA_Disabled, 1)
return
/**/
/***//*** EH_SetGads *********/
EH_SetGads:
if EH_SelectMonth ~= 14 then do
do EH_i = 1 to EH_Button
EH_temp = EH_Button.EH_i
if EH_Arg.EH_temp ~= 'dummy' then interpret "call bguiset(obj."EH_i"_,EH_winID, GA_Disabled, 0)"
end
call bguiset(obj.EH_highlighttype_,EH_winID,GA_Disabled, 0)
call bguiset(obj.EH_weeknumber_,EH_winID,GA_Disabled, 0)
call bguiset(obj.EH_weektype_,EH_winID,GA_Disabled, 0)
call bguiset(obj.EH_weekend_,EH_winID,GA_Disabled, 0)
end
else call bguiset(obj.EH_easter_,EH_winID, GA_Disabled, 0)
call bguiset(obj.EH_event_,EH_winID,GA_Disabled, 0)
call bguiset(obj.EH_comment_,EH_winID,GA_Disabled, 0)
call bguiset(obj.EH_highlightcolor_,EH_winID,GA_Disabled, 0)
call bguiset(obj.EH_eventimage_,EH_winID,GA_Disabled, 0)
call bguiset(obj.EH_holiday_,EH_winID,GA_Disabled, 0)
call bguiset(obj.EH_delete_,EH_winID, GA_Disabled, 0)
return
/**/
/***//*** EH_SetRequester *********/
call EH_SetRequester:
/* Set 'Prev' & 'Next' gads */
if EH_CurrentPointer < 2 then call bguiset(obj.EH_prev_,EH_winID,GA_Disabled, 1)
else call bguiset(obj.EH_prev_,EH_winID,GA_Disabled, 0)
if EH_CurrentPointer == EH_EntryCount then call bguiset(obj.EH_next_,EH_winID,GA_Disabled, 1)
else call bguiset(obj.EH_next_,EH_winID,GA_Disabled, 0)
if EH_EntryCount > 0 then do
if EH_SelectMonth < 14 then do
/* De-select existing date button */
if EH_DayShowing ~= 0 then do
EH_GadgetID = EH_ButtonID.EH_DayShowing
interpret "call bguiset(obj."EH_GadgetID"_,EH_winID, GA_Selected, 0)"
end
/* Select current date button */
EH_EventDay = EH_EventDay.EH_CurrentEntry
EH_GadgetID = EH_ButtonID.EH_EventDay
EH_HighlightType = EH_HighlightType.EH_CurrentEntry
interpret "call bguiset(obj."EH_GadgetID"_,EH_winID, GA_Selected, 1)"
interpret 'call bguiset(obj.EH_highlighttype_,EH_winID,CYC_Active,EH_HighlightTypeCyc.'EH_HighlightType')'
interpret 'call EH_Set'EH_HighlightType
interpret 'call bguiset(obj.EH_weekend_,EH_winID,CYC_Active,EH_WeekendCyc.'EH_Weekend.EH_CurrentEntry')'
call bguiset(obj.EH_holiday_,EH_winID,GA_Selected,EH_Holiday.EH_CurrentEntry)
if EH_HighlightType == 'Float' then call EH_CheckWeekNumber
else if EH_HighlightType == 'BiOrWeekly' then call EH_CheckWeekType
end
else call bguiset(obj.EH_easter_, EH_winID, STRINGA_TextVal,EH_EventDay.EH_CurrentEntry)
/* Set event & comment */
call bguiset(obj.EH_event_, EH_winID, STRINGA_TextVal,EH_Event.EH_CurrentEntry)
call bguiset(obj.EH_comment_, EH_winID, STRINGA_TextVal,EH_Comment.EH_CurrentEntry)
call bguiset(obj.EH_highlightcolor_,EH_winID,CYC_Active,EH_Color.EH_CurrentEntry)
end
else call EH_GhostGads
return
/**/
/**/
/***//*** EditHighlight_CA (EH) ***/
EditHighlight_CA:
/***//*** Initialize Variables ***/
Req = OpenBusy(PrepReq$, 6)
EH_DayShowing = 0
EH_WeekendCyc.0 = "OK"
EH_WeekendCyc.1 = "P"
EH_WeekendCyc.2 = "N"
EH_WeekendCyc.OK = 0
EH_WeekendCyc.P = 1
EH_WeekendCyc.N = 2
EH_WeekTypeCyc.0 = "All"
EH_WeekTypeCyc.1 = "Odd"
EH_WeekTypeCyc.2 = "Even"
EH_WeekTypeCyc.All = 0
EH_WeekTypeCyc.Odd = 1
EH_WeekTypeCyc.Even = 2
EH_HighlightTypeCyc.Fixed = 0
EH_HighlightTypeCyc.Float = 1
EH_HighlightTypeCyc.BiOrWeekly = 2
EH_HighlightTypeCyc.Easter = 3
EH_HighlightTypeCyc.0 = 'Fixed'
EH_HighlightTypeCyc.1 = 'Float'
EH_HighlightTypeCyc.2 = 'BiOrWeekly'
EH_HighlightTypeCyc.3 = 'Easter'
EH_KeywordCode.00 = 'Highlight'
EH_KeywordCode.01 = 'Image'
EH_KeywordCode.10 = 'CalculateDate'
EH_KeywordCode.11 = 'CalculateImage'
EH_KeywordCode.20 = 'CalculateDate'
EH_KeywordCode.21 = 'CalculateImage'
EH_Year = left(date('S'),4)
interpret 'EH_StartYear = Day.'DateInfo('W', EH_Year'0101', 'S')
EH_YearOffset = 7 - EH_StartYear
if EH_YearOffset == 7 then EH_YearOffset = 0
EH_SelectMonth = right(EH_SelectMonth, 2, '0')
/**/
/***//*** GUI Description ***/
if UpdateBusy(Req, 1) == -1 then call EH_CACleanup
HighlightTypeList = '"'Fixed$'|'Floating$'|'BiOrWeekly$'"'
WeekNumberList = '"'First$'|'Second$'|'Third$'|'Fourth$'|'Last$'"'
WeekTypeList = '"'All$'|'Odd$'|'Even$'"'
WeekendList = '"'OK2$'|'PreviousDay$'|'NextDay$'"'
EH_MonthList = strip(MonthList, 'T', '"')'|'All$'|'Easter$'"'
call open('EH',"awnpipe:SetupReq/xc")
call ToPIPE('EH', '"'EnterEventInfo$'" m cg dg v db a so si cs sq sk h ps="'AppScreen'"')
call ToPIPE('EH', 'layout v so si b=0')
call ToPIPE('EH', 'layout b=0')
call ToPIPE('EH', 'label gt="'Event$':" ua')
call AssignID('EH_EventGad', ToPIPE('EH', 'string lj tc chl ref'))
call AssignID('EH_ChooseEventGad', ToPIPE('EH', 'button ab=0 weiw=0 weih=0 ref'))
call AssignID('EH_ListEventGad', ToPIPE('EH', 'chooser weiw=0 weih=0 ref'))
call AssignID('EH_CycleEventGad', ToPIPE('EH', 'button weiw=0 gt=">" ref'))
call ToPIPE('EH', 'le')
call ToPIPE('EH', 'layout b=0')
call ToPIPE('EH', 'label gt="'Comment$':" ua')
call AssignID('EH_CommentGad', ToPIPE('EH', 'string lj tc chl ref'))
call ToPIPE('EH', 'le')
call ToPIPE('EH', 'le')
call ToPIPE('EH', 'layout weiw=0 b=0')
call ToPIPE('EH', 'layout weiw=0 so v')
call ToPIPE('EH', 'layout so b=0')
call ToPIPE('EH', 'space')
call AssignID('EH_MonthGad', ToPIPE('EH', 'chooser pu weiw=5 maxn=14 cl='EH_Monthlist' ref'))
call ToPIPE('EH', 'space')
call ToPIPE('EH', 'le')
call ToPIPE('EH', 'layout e b=0')
call ToPIPE('EH', 'button ro b=0 gt="'left(Day.0, 1)'"')
call ToPIPE('EH', 'button ro b=0 gt="'left(Day.1, 1)'"')
call ToPIPE('EH', 'button ro b=0 gt="'left(Day.2, 1)'"')
call ToPIPE('EH', 'button ro b=0 gt="'left(Day.3, 1)'"')
call ToPIPE('EH', 'button ro b=0 gt="'left(Day.4, 1)'"')
call ToPIPE('EH', 'button ro b=0 gt="'left(Day.5, 1)'"')
call ToPIPE('EH', 'button ro b=0 gt="'left(Day.6, 1)'"')
call ToPIPE('EH', 'le')
if UpdateBusy(Req, 1) == -1 then call EH_CACleanup
GadID. = ''
do EH_Week = 0 to 5
call ToPIPE('EH', 'layout e b=0')
do EH_WeekDay = 0 to 6
EH_Posn = (EH_Week * 7) + EH_WeekDay
call AssignID('GadID.'EH_Posn, ToPIPE('EH', 'button pb'))
end
call ToPIPE('EH', 'le')
end
call ToPIPE('EH', 'le')
if UpdateBusy(Req, 1) == -1 then call EH_CACleanup
call ToPIPE('EH', 'layout weiw=0 si so v')
call ToPIPE('EH', 'layout weiw=0 si so b=0 v')
call ToPIPE('EH', 'label weiw=0 ua gt="'Color$':"')
call AssignID('EH_ColorGad', ToPIPE('EH', 'button chl weih=0 ref'))
call ToPIPE('EH', 'label weiw=0 gt="'Type$':" ua')
call AssignID('EH_HLTypeGad', ToPIPE('EH', 'chooser chl pu weiw=0 maxn=3 cl='HighlightTypeList' ref'))
call ToPIPE('EH', 'label weiw=0 gt="'WeekNumber$':" ua')
call AssignID('EH_WeekNumberGad', ToPIPE('EH', 'chooser chl pu weiw=0 maxn=5 cl='WeekNumberList' ref'))
call ToPIPE('EH', 'label weiw=0 gt="'WeekType$':" ua')
call AssignID('EH_WeekTypeGad', ToPIPE('EH', 'chooser chl pu weiw=0 maxn=3 cl='WeekTypeList' ref'))
call ToPIPE('EH', 'label weiw=0 gt="'Weekend$':" ua')
call AssignID('EH_WeekendGad', ToPIPE('EH', 'chooser chl pu weiw=0 maxn=3 cl='WeekendList' ref'))
call ToPIPE('EH', 'label weiw=0 gt="'Holiday$':" ua')
call AssignID('EH_HolidayGad', ToPIPE('EH', 'checkbox weiw=0 chl ref'))
call ToPIPE('EH', 'label weiw=0 gt="'Easter$':" ua')
call AssignID('EH_EasterGad', ToPIPE('EH', 'integer a tc minn=-366 maxn=366 weiw=0 lj chl ref'))
call ToPIPE('EH', 'le')
call ToPIPE('EH', 'layout v si e cj b=0')
call ToPIPE('EH', 'layout si e weiw=0 b=0')
call AssignID('EH_AddEventGad', ToPIPE('EH', 'button weiw=0 weih=0 gt="'AddEvent$'" ref'))
call AssignID('EH_DeleteEventGad', ToPIPE('EH', 'button weiw=0 weih=0 gt="'DeleteEvent$'" ref'))
call ToPIPE('EH', 'le')
call AssignID('EH_DoneGad', ToPIPE('EH', 'button weih=0 weiw=0 gt="'Done$'" c ref'))
call ToPIPE('EH', 'le')
call ToPIPE('EH', 'le')
call ToPIPE('EH', 'le')
GetEHFileGad = ToPIPE('EH', 'getfile ua pat="#?"')
GadText.EH_CycleEventGad.0 = '>'
GadText.EH_CycleEventGad.1 = '<'
/**/
/***//*** GUI Action Loop ***/
call ToPIPE('EH', 'open')
if UpdateBusy(Req, 1) == -1 then call EH_CACleanup
call EH_CASetRequester
call CloseBusy('ProgReq')
EH_Done = 0
do until eof('EH')
call ToPIPE('EH', 'continue')
EH_EventInfo = readln('EH')
parse var EH_EventInfo EH_Event' 'EH_GadID' 'EH_GadInfo1
select
/***//*** Close ***/
when EH_Event == 'close' then do
if EH_GadID == EH_DoneGad then call EH_CASaveHighlightData
EH_Done = 1
end
/**/
/***//*** Help ***/
when EH_Event == 'help' then do
if EH_GadID ~= -1 then do
OverGad = EH_GadID
if (EH_GadID ~= ShiftedGad) & (ShiftedGad > 0) then do
call ToPIPE('EH', 'id 'ShiftedGad' gt="'GadText.ShiftedGad.0'"')
ShiftedGad = 0
end
if (ShiftDown == 1) & (symbol('GadText.OverGad.1') == 'VAR') then do
call ToPIPE('EH', 'id 'OverGad' gt="'GadText.OverGad.1'"')
ShiftedGad = OverGad
end
end
end
/**/
/***//*** Qualifers ***/
when EH_Event == 'qual' then do
ShiftDown = (EH_GadID == 1)|(EH_GadID == 2)
if (ShiftDown == 0) & (ShiftedGad > 0) then do
call ToPIPE('EH', 'id 'ShiftedGad' gt="'GadText.OverGad.0'"')
ShiftedGad = 0
end
if (ShiftDown == 1) & (symbol('GadText.OverGad.1') == 'VAR') then do
call ToPIPE('EH', 'id 'OverGad' gt="'GadText.OverGad.1'"')
ShiftedGad = OverGad
end
end
/**/
/***//*** Key event ***/
when EH_Event == 'key' then do
HelpGad = DSR_Help.OverGad
interpret 'HelpText = Help$.'HelpGad
if EH_Day.OverGad == 'LD' then HelpText = Help$.LD
if (EH_GadID == 95) & (symbol('Help$.'HelpGad) == 'VAR') then
call CASimpleReq(Help$, HelpText, HelpTime)
end
/**/
/***//*** EH_EventGad ***/
when EH_GadID == EH_EventGad then call EH_CAProcessEventGad(EH_GadInfo1)
/**/
/***//*** EH_ChooseEventGad ***/
when EH_GadID == EH_ChooseEventGad then do
address command 'assign >NIL: FWC: 'ScriptDir'Images/'
if RC == 20 then EH_Dir = ScriptDir
else do
EH_Dir = ScriptDir'Images/'
address command 'assign >NIL: FWC:'
end
EH_DataFile = CAGetFile('EH', GetEHFileGad, SelectImage$, EH_Dir)
if EH_DataFile ~= '' then do
if exists(EH_DataFile) then do
EH_Event.EH_CurrentEntry = EH_DataFile
EH_Image.EH_CurrentEntry = 1
call ToPIPE('EH', 'id 'EH_EventGad' gt="'EH_DataFile'"')
end
else do
call ToPIPE('EH', 'id 0 s=256')
call CASimpleReq('FWCalendar 'Notice$, EH_DataFile' 'CantFind$'...')
call ToPIPE('EH', 'id 0 s=512')
end
end
call EH_CAUpdateEventList
end
/**/
/***//*** EH_ListEventGad ***/
when EH_GadID == EH_ListEventGad then do
EH_Comment.EH_CurrentEntry = ReadCAGad('EH', EH_CommentGad)
call EH_CAProcessEventGad(ReadCAGad('EH', EH_EventGad))
EH_CurrentPointer = EH_GadInfo1 + 1
EH_CurrentEntry = EH_Pointer.EH_CurrentPointer
call EH_CASetEvent
end
/**/
/***//*** EH_CycleEventGad ***/
when EH_GadID == EH_CycleEventGad then do
EH_Comment.EH_CurrentEntry = ReadCAGad('EH', EH_CommentGad)
call EH_CAProcessEventGad(ReadCAGad('EH', EH_EventGad))
if ShiftDown == 1 then do
EH_CurrentPointer = EH_CurrentPointer - 1
if EH_CurrentPointer == 0 then EH_CurrentPointer = EH_EntryCount
EH_CurrentEntry = EH_Pointer.EH_CurrentPointer
end
else do
EH_CurrentPointer = EH_CurrentPointer + 1
if EH_CurrentPointer > EH_EntryCount then EH_CurrentPointer = 1
EH_CurrentEntry = EH_Pointer.EH_CurrentPointer
end
call EH_CASetEvent
end
/**/
/***//*** EH_CommentGad ***/
when EH_GadID == EH_CommentGad then EH_Comment.EH_CurrentEntry = EH_GadInfo1
/**/
/***//*** EH_MonthGad ***/
when EH_GadID == EH_MonthGad then do
EH_Comment.EH_CurrentEntry = ReadCAGad('EH', EH_CommentGad)
call EH_CAProcessEventGad(ReadCAGad('EH', EH_EventGad))
call EH_CASaveHighlightData
EH_SelectMonth = right(EH_GadInfo1 + 1, 2, '0')
call EH_CASetRequester
end
/**/
/***//*** EH_ColorGad ***/
when EH_GadID == EH_ColorGad then do
call ToPIPE('EH', 'id 0 s=256')
EH_Color.EH_CurrentEntry = ReadBrowserList('ColorReq', 'ColorGad', 'ColorList')
call ToPIPE('EH', 'id 'EH_ColorGad' gt="'EH_Color.EH_CurrentEntry'"')
call ToPIPE('EH', 'id 0 s=512')
end
/**/
/***//*** EH_HLTypeGad ***/
when EH_GadID == EH_HLTypeGad then do
EH_HighlightType.EH_CurrentEntry = EH_GadInfo1
select
when EH_HighlightTypeCyc.EH_GadInfo1 == 'Fixed' then call EH_CASetFixedGads
when EH_HighlightTypeCyc.EH_GadInfo1 == 'Float' then do
call EH_CASetFloatGads
call EH_CACheckWeekNumber
end
when EH_HighlightTypeCyc.EH_GadInfo1 == 'BiOrWeekly' then do
call EH_CASetBiOrWeeklyGads
call EH_CACheckWeekType
end
end
end
/**/
/***//*** EH_WeekNumberGad ***/
when EH_GadID == EH_WeekNumberGad then do
EH_Weeknumber.EH_CurrentEntry = EH_GadInfo1
if EH_EventDay.EH_CurrentEntry > 0 then do
call ToPIPE('EH', 'id 'EH_ButtonID.EH_DayShowing' s=0 ref')
EH_EventDay = EH_EventDay.EH_CurrentEntry
do until EH_EventDay < 1
EH_EventDay = EH_EventDay - 7
end
do EH_i = 0 to EH_Weeknumber.EH_CurrentEntry
EH_EventDay = EH_EventDay + 7
end
if EH_EventDay > MonthLength.EH_ShortMonth then EH_EventDay = EH_EventDay - 7
call ToPIPE('EH', 'id 'EH_ButtonID.EH_EventDay' s=1')
EH_EventDay.EH_CurrentEntry = EH_EventDay
EH_DayShowing = EH_EventDay
end
end
/**/
/***//*** EH_WeekTypeGad ***/
when EH_GadID == EH_WeekTypeGad then do
EH_WeekType.EH_CurrentEntry = EH_GadInfo1
if EH_EventDay.EH_CurrentEntry > 0 then do
call ToPIPE('EH', 'id 'EH_ButtonID.EH_DayShowing' s=0 ref')
EH_EventDay = EH_EventDay.EH_CurrentEntry
if (EH_WeekType.EH_CurrentEntry ~= 0) & (EH_TempWeekType.EH_CurrentEntry ~= EH_WeekType.EH_CurrentEntry) then do
if EH_EventDay - 7 < 1 then EH_EventDay = EH_EventDay + 7
else EH_EventDay = EH_EventDay - 7
end
call ToPIPE('EH', 'id 'EH_ButtonID.EH_EventDay' s=1')
EH_EventDay.EH_CurrentEntry = EH_EventDay
EH_DayShowing = EH_EventDay
EH_TempWeekType.EH_CurrentEntry = EH_WeekType.EH_CurrentEntry
end
end
/**/
/***//*** EH_WeekendGad ***/
when EH_GadID == EH_WeekendGad then EH_Weekend.EH_CurrentEntry = EH_GadInfo1
/**/
/***//*** EH_HolidayGad ***/
when EH_GadID == EH_HolidayGad then EH_Holiday.EH_CurrentEntry = EH_GadInfo1
/**/
/***//*** EH_EasterGad ***/
when EH_GadID == EH_EasterGad then do
EH_Easter.EH_CurrentEntry = EH_GadInfo1
EH_EventDay.EH_CurrentEntry = EH_GadInfo1
call EH_CASortAndFind(EH_CurrentEntry)
end
/**/
/***//*** EH_AddEventGad ***/
when EH_GadID == EH_AddEventGad then do
EH_Comment.EH_CurrentEntry = ReadCAGad('EH', EH_CommentGad)
call EH_CAProcessEventGad(ReadCAGad('EH', EH_EventGad))
if EH_EntryCount == 0 then call EH_CASetMonthGads
if EH_DayShowing ~= 0 then call ToPIPE('EH', 'id 'EH_ButtonID.EH_DayShowing' s=0 ref')
EH_EntryCount = EH_EntryCount + 1
EH_CurrentEntry = EH_EntryCount
EH_Event.EH_CurrentEntry = ''
EH_Comment.EH_CurrentEntry = ''
EH_EventDay.EH_CurrentEntry = 1
EH_Holiday.EH_CurrentEntry = 0
EH_Color.EH_CurrentEntry = '<'Clear$'>'
if EH_SelectMonth < 14 then do
EH_HighlightType.EH_CurrentEntry = 0
EH_Keyword.EH_CurrentEntry = 'Highlight'
EH_Weekend.EH_CurrentEntry = 0
end
call EH_CASortAndFind(EH_CurrentEntry)
call EH_CASetEvent
end
/**/
/***//*** EH_DeleteEventGad ***/
when EH_GadID == EH_DeleteEventGad then do
if EH_EntryCount == 1 then do
EH_CurrentEntry = 0
EH_CurrentPointer = 0
EH_EntryCount = 0
call EH_CAGhostGads
end
else do
SortFile = ''
do EH_i = 1 to EH_EntryCount
if EH_i ~= EH_CurrentEntry then SortFile = SortFile''right(EH_i, 3, "0")' 'EH_EventDay.EH_i||'0a'x
end
call writefile('pipe:FWC', strip(SortFile, 'B', '0a'x))
address command 'sort pipe:FWC Pipe:FWC1 Colstart 5 numeric'
if EH_CurrentPointer == EH_EntryCount then EH_CurrentPointer = EH_CurrentPointer - 1
else EH_CurrentPointer = EH_CurrentPointer + 1
EH_CurrentEntry = EH_Pointer.EH_CurrentPointer
EH_EntryCount = EH_EntryCount - 1
SortedFile = ReadFile('pipe:FWC1')
call openv('SortedFile')
do EH_i = 1 to EH_EntryCount
EH_Pointer.EH_i = left(readvln('SortedFile'), 3) - 0
if EH_Pointer.EH_i == EH_CurrentEntry then EH_CurrentPointer = EH_i
end
call closev('SortedFile')
call EH_CAUpdateEventList
call EH_CASetEvent
end
call EH_CASetPrevAndNext
end
/**/
/***//*** Date gadgets ***/
otherwise do
if symbol('EH_Day.EH_GadID') == 'VAR' then do
EH_EventDay.EH_CurrentEntry = EH_Day.EH_GadID
if EH_EventDay.EH_CurrentEntry == EH_DayShowing then call ToPIPE('EH', 'id 'EH_ButtonID.EH_DayShowing' s=1')
else do
/* Clear previous date button if necessary */
if EH_DayShowing ~= 0 then call ToPIPE('EH', 'id 'EH_ButtonID.EH_DayShowing' s=0 ref')
/* Set current date button */
EH_DayShowing = EH_EventDay.EH_CurrentEntry
call ToPIPE('EH', 'id 'EH_ButtonID.EH_DayShowing' s=1')
/* Check for impacts of change */
if EH_HighlightType.EH_CurrentEntry == EH_HighlightTypeCyc.Float then call EH_CACheckWeekNumber
else if EH_HighlightType.EH_CurrentEntry == EH_HighlightTypeCyc.BiOrWeekly then call EH_CACheckWeekType
call EH_CASortAndFind(EH_CurrentEntry)
end
end
end
/**/
end
if EH_Done ~= 0 then leave
if (EH_Event = 'gadget') & (ShiftDown = 1) & (symbol('GadText.EH_GadID.1') == 'VAR') then do
ShiftedGad = EH_GadID
OverGad = EH_GadID
call ToPIPE('EH', 'id 'ShiftedGad' gt="'GadText.ShiftedGad.1'"')
end
end
OverGad = 0
ShiftDown = 0
ShiftedGad = 0
call close('EH')
return
/**/
/***//*** EH_CACheckWeekNumber ***/
EH_CACheckWeekNumber:
EH_TempDay = EH_EventDay.EH_CurrentEntry
EH_Weeknumber.EH_CurrentEntry = 0
do until EH_TempDay < 0
EH_TempDay = EH_TempDay - 7
if EH_TempDay > 0 then EH_Weeknumber.EH_CurrentEntry = EH_Weeknumber.EH_CurrentEntry + 1
end
call ToPIPE('EH', 'id 'EH_WeekNumberGad' s='EH_Weeknumber.EH_CurrentEntry)
return
/**/
/***//*** EH_CACheckWeekType ***/
EH_CACheckWeekType:
interpret 'EH_StartYear = Day.'DateInfo('W', EH_Year'0101', 'S')
EH_YearOffset = 7 - EH_StartYear
if EH_YearOffset == 7 then EH_YearOffset = 0
EH_Week = 2 - (trunc((right(DateInfo('J', EH_Year''EH_Month''right(EH_EventDay.EH_CurrentEntry, 2, '0'), 'S'), 3) - EH_YearOffset - 1)/7 + 1))//2
call ToPIPE('EH', 'id 'EH_WeekTypeGad' s='EH_Week)
return
/**/
/***//*** EH_CACleanup ***/
EH_CACleanup:
call CloseBusy('ProgReq')
call close('EH')
return
/**/
/***//*** EH_CAGhostGads ***/
EH_CAGhostGads:
do EH_Posn = 0 to 41
call ToPIPE('EH', 'id 'GadID.EH_Posn' s=0 dis=1')
end
call ToPIPE('EH', 'id 'EH_EventGad' gt="" dis=1 ref')
call ToPIPE('EH', 'id 'EH_ChooseEventGad' dis=1 ref')
call ToPIPE('EH', 'id 'EH_ListEventGad' dis=1')
call ToPIPE('EH', 'id 'EH_CycleEventGad' dis=1')
call ToPIPE('EH', 'id 'EH_CommentGad' gt="" dis=1')
call ToPIPE('EH', 'id 'EH_ColorGad' dis=1')
call ToPIPE('EH', 'id 'EH_HLTypeGad' dis=1')
call ToPIPE('EH', 'id 'EH_WeekNumberGad' dis=1')
call ToPIPE('EH', 'id 'EH_WeekTypeGad' dis=1')
call ToPIPE('EH', 'id 'EH_WeekendGad' dis=1')
call ToPIPE('EH', 'id 'EH_HolidayGad' dis=1 ref')
call ToPIPE('EH', 'id 'EH_EasterGad' dis=1 ref')
call ToPIPE('EH', 'id 'EH_DeleteEventGad' dis=1')
return
/**/
/***//*** EH_CAProcessEventGad ***/
EH_CAProcessEventGad:
parse arg Value
EH_Event.EH_CurrentEntry = Value
parse var EH_Event.EH_CurrentEntry EH_Image','EH_X.EH_CurrentEntry','EH_Y.EH_CurrentEntry
if exists(EH_Image) then EH_Image.EH_CurrentEntry = 1
else EH_Image.EH_CurrentEntry = 0
call EH_CAUpdateEventList
return
/**/
/***//*** EH_CAReadData ***/
EH_CAReadData:
EH_EntryCount = 0
OverGad = 0
ShiftDown = 0
ShiftedGad = 0
EH_MonthCount = MonthCount.EH_SelectMonth
if EH_MonthCount > 0 then do
do EH_j = 1 to EH_MonthCount
EH_EntryCount = EH_EntryCount + 1
if EH_SelectMonth < 14 then CurrentData.EH_SelectMonth.EH_j = substr(HighlightData.EH_SelectMonth.EH_j, 3)
else CurrentData.EH_SelectMonth.EH_j = HighlightData.EH_SelectMonth.EH_j
if symbol('CurrentData.EH_SelectMonth.EH_j') == 'VAR' then do
EH_HighlightData = strip(CurrentData.EH_SelectMonth.EH_j)
if right(EH_HighlightData, 2) == '*/' then do
EH_StartComment = lastpos('/*', EH_HighlightData)
EH_Comment.EH_EntryCount = strip(substr(EH_HighlightData, EH_StartComment), 'B', ' /*')
EH_HighlightData = strip(left(EH_HighlightData, EH_StartComment - 1))
end
else EH_Comment.EH_EntryCount = ''
EH_Keyword = word(EH_HighlightData, 1)
EH_FirstDot = pos('.', EH_Keyword)
EH_FirstParen = pos('(', EH_Keyword)
if EH_FirstDot == 0 then EH_EndOfKeyword = EH_FirstParen
else if EH_FirstParen == 0 then EH_EndOfKeyword = EH_FirstDot
else EH_EndOfKeyword = min(pos('.', EH_Keyword), pos('(', EH_Keyword))
EH_Keyword.EH_EntryCount = left(EH_Keyword, EH_EndOfKeyword - 1)
if pos('IMAGE', upper(EH_Keyword.EH_EntryCount)) ~= 0 then EH_Image.EH_EntryCount = 1
else EH_Image.EH_EntryCount = 0
if (upper(EH_Keyword.EH_EntryCount) == 'HIGHLIGHT') | (upper(EH_Keyword.EH_EntryCount) == 'IMAGE') then do
EH_HighlightType.EH_EntryCount = EH_HighlightTypeCyc.Fixed
EH_EventDay.EH_EntryCount = substr(EH_Keyword, lastpos('.', EH_Keyword) + 1)
EH_Event.EH_EntryCount = substr(EH_HighlightData, pos('=', EH_HighlightData) + 1)
parse var EH_Event.EH_EntryCount EH_Event.EH_EntryCount','EH_Color.EH_EntryCount
if upper(EH_Keyword.EH_EntryCount) == 'IMAGE' then do
if (pos(':', EH_Event.EH_EntryCount) == 0) & (pos('/', EH_Event.EH_EntryCount) == 0) then
EH_Event.EH_EntryCount = ScriptDir'Images/'strip(EH_Event.EH_EntryCount, 'B', ' "'||"'")
end
end
else do
EH_HighlightData = strip(substr(EH_HighlightData, EH_EndOfKeyword + 1), 'B', ')')
if EH_SelectMonth == 14 then do
parse var EH_HighlightData EH_EventDay.EH_EntryCount','EH_Event.EH_EntryCount','EH_Color.EH_EntryCount
EH_EventDay.EH_EntryCount = strip(EH_EventDay.EH_EntryCount)
EH_Easter.EH_EntryCount = EH_EventDay.EH_EntryCount
EH_Event.EH_EntryCount = strip(EH_Event.EH_EntryCount)
EH_HighlightType.EH_EntryCount = EH_HighlightTypeCyc.Easter
EH_Keyword.EH_EntryCount = 'CalculateEDate'
end
else do
parse var EH_HighlightData .','EH_DayOfWeek','EH_HighDate','EH_Event.EH_EntryCount','EH_Color.EH_EntryCount
interpret "EH_DayOfWeek = Day."strip(EH_DayOfWeek, 'B', ' "'||"'")
EH_HighDate = strip(EH_HighDate)
EH_Event.EH_EntryCount = strip(EH_Event.EH_EntryCount)
if pos('IMAGE', upper(EH_Keyword.EH_EntryCount)) > 0 then do
if (pos(':', EH_Event.EH_EntryCount) == 0) & (pos('/', EH_Event.EH_EntryCount) == 0) then do
EH_Event.EH_EntryCount = ScriptDir'Images/'strip(EH_Event.EH_EntryCount, 'B', ' "'||"'")
end
end
if datatype(EH_HighDate) == 'CHAR' then do
/* Weekly/Biweekly events */
EH_HighDate = upper(strip(EH_HighDate, 'B', "'"))
EH_HighlightType.EH_EntryCount = EH_HighlightTypeCyc.BiOrWeekly
interpret 'EH_WeekType.EH_EntryCount = EH_WeekTypeCyc.'EH_HighDate
EH_EventOffset = EH_DayOfWeek - EH_StartDate
EH_EventDay.EH_EntryCount = 1 + EH_EventOffset
if EH_EventDay.EH_EntryCount < 1 then EH_EventDay.EH_EntryCount = EH_EventDay.EH_EntryCount + 7
EH_WN = trunc((right(DateInfo('J', EH_Year''EH_Month''right(EH_EventDay.EH_EntryCount, 2, '0'), 'S'), 3) - EH_YearOffset - 1)/7 + 1)
if ((EH_HighDate == 'EVEN') & (EH_WN//2 == 1)) | ((EH_HighDate == 'ODD') & (EH_WN//2 == 0)) then EH_EventDay.EH_EntryCount = EH_EventDay.EH_EntryCount + 7
end
else do
EH_HighlightType.EH_EntryCount = EH_HighlightTypeCyc.Float
interpret 'EH_First = Day.'DateInfo('W', EH_Year''EH_Month'01', 'S')
EH_EventDay.EH_EntryCount = EH_HighDate + (EH_DayOfWeek - EH_First)
if EH_First < EH_DayOfWeek then EH_EventDay.EH_EntryCount = EH_EventDay.EH_EntryCount - 7
EH_TempDay = EH_EventDay.EH_EntryCount
EH_Weeknumber.EH_EntryCount = 0
if EH_HighDate > 28 then EH_Weeknumber.EH_EntryCount = 4
else do
do until EH_TempDay < 0
EH_TempDay = EH_TempDay - 7
if EH_TempDay > 0 then EH_Weeknumber.EH_EntryCount = EH_Weeknumber.EH_EntryCount + 1
end
end
end
end
end
if datatype(EH_EventDay.EH_EntryCount) == 'CHAR' then do
interpret 'EH_Weekend.EH_EntryCount = EH_WeekendCyc.'upper(right(EH_EventDay.EH_EntryCount, 1))
EH_EventDay.EH_EntryCount = left(EH_EventDay.EH_EntryCount, length(EH_EventDay.EH_EntryCount) - 1)
end
else EH_Weekend.EH_EntryCount = EH_WeekendCyc.OK
if EH_EventDay.EH_EntryCount == '32' then EH_EventDay.EH_EntryCount = 'LD'
EH_Event.EH_EntryCount = strip(EH_Event.EH_EntryCount, 'B', ' "'||"'")
if right(EH_Event.EH_EntryCount, 1) == '#' then do
EH_Holiday.EH_EntryCount = 128
EH_Event.EH_EntryCount = left(EH_Event.EH_EntryCount, length(EH_Event.EH_EntryCount) - 1)
end
else EH_Holiday.EH_EntryCount = 0
end
EH_Color.EH_EntryCount = strip(EH_Color.EH_EntryCount, 'B', ' "'||"'")
if EH_Color.EH_EntryCount == '' then EH_Color.EH_EntryCount = '<'Clear$'>'
end
call EH_CASortAndFind(1)
end
EH_HighEntry = EH_EntryCount
if EH_EntryCount > 0 then do
EH_CurrentPointer = 1
EH_CurrentEntry = EH_Pointer.EH_CurrentPointer
end
else do
EH_CurrentEntry = 0
EH_CurrentPointer = 0
end
return
/**/
/***//*** EH_CASaveHighlightData ***/
EH_CASaveHighlightData:
EH_Comment.EH_CurrentEntry = ReadCAGad('EH', EH_CommentGad)
call EH_CAProcessEventGad(ReadCAGad('EH', EH_EventGad))
do EH_i = 1 to EH_EntryCount
EH_CurrentPointer = EH_i
EH_CurrentEntry = EH_Pointer.EH_CurrentPointer
EH_EventDay = EH_EventDay.EH_CurrentEntry
EH_Weekend = EH_Weekend.EH_CurrentEntry
EH_HighlightType = EH_HighlightType.EH_CurrentEntry
interpret 'EH_Keyword = EH_KeywordCode.'EH_HighlightType.EH_CurrentEntry''EH_Image.EH_CurrentEntry
if EH_EventDay == 'LD' then EH_EventDay = 32
if EH_Holiday.EH_CurrentEntry == 1 then EH_Event.EH_CurrentEntry = EH_Event.EH_CurrentEntry'#'
if EH_WeekendCyc.EH_Weekend ~= 'OK' then EH_EventDay = EH_EventDay''EH_WeekendCYC.EH_Weekend
if (upper(EH_Keyword) == 'HIGHLIGHT') | (upper(EH_Keyword) == 'IMAGE') then do
EH_DataLine = EH_SelectMonth''EH_Keyword'.'EH_SelectMonth - 0'.'EH_EventDay' = 'QuoteIt(EH_Event.EH_CurrentEntry)
if upper(EH_Keyword) == 'HIGHLIGHT' then EH_DataLine = EH_DataLine', 'QuoteIt(EH_Color.EH_CurrentEntry)
end
else if (upper(EH_Keyword) == 'CALCULATEDATE') | (upper(EH_Keyword) == 'CALCULATEIMAGE') then do
EH_DayOfWeek = DateInfo('W', EH_Year''EH_Month''right(EH_EventDay.EH_CurrentEntry, 2, '0'), 'S')
if EH_HighlightTypeCyc.EH_HighlightType == 'Float' then do
interpret 'EH_DayNumber = Day.'EH_DayOfWeek
if EH_Weeknumber.EH_CurrentEntry < 4 then do
EH_DayNumber = EH_DayNumber + 1
if EH_DayNumber == 7 then EH_DayNumber = 0
interpret 'EH_DayOfWeek = Day.'EH_DayNumber
EH_EventDay = 7 * (EH_Weeknumber.EH_CurrentEntry + 1)
end
else do
EH_EventDay = Monthlength.EH_ShortMonth
EH_TempDay = Monthlength.EH_ShortMonth - 29
EH_DayNumber = EH_DayNumber - EH_TempDay
if EH_DayNumber < 0 then EH_DayNumber = EH_DayNumber + 7
else if EH_DayNumber > 6 then EH_DayNumber = EH_DayNumber - 7
interpret 'EH_DayOfWeek = Day.'EH_DayNumber
end
end
else EH_EventDay = "'"EH_WeekTypeCyc.EH_CurrentEntry"'"
EH_DataLine = EH_SelectMonth''EH_Keyword'('EH_SelectMonth - 0', 'QuoteIt(EH_DayOfWeek)', 'EH_EventDay', 'QuoteIt(EH_Event.EH_CurrentEntry)
if upper(EH_Keyword) == 'CALCULATEDATE' then EH_DataLine = EH_DataLine', 'QuoteIt(EH_Color.EH_CurrentEntry)
EH_DataLine = EH_DataLine')'
end
else if EH_SelectMonth == 14 then
EH_DataLine = 'CalculateEDate('EH_EventDay.EH_CurrentEntry', 'QuoteIt(EH_Event.EH_CurrentEntry)', 'QuoteIt(EH_Color.EH_CurrentEntry)')'
if EH_Comment.EH_CurrentEntry ~= '' then EH_DataLine = EH_DataLine' /* 'EH_Comment.EH_CurrentEntry' */'
HighlightData.EH_SelectMonth.EH_i = EH_DataLine
end
MonthCount.EH_SelectMonth = EH_EntryCount
return
/**/
/***//*** EH_CASetBiOrWeeklyGads ***/
EH_CASetBiOrWeeklyGads:
call ToPIPE('EH', 'id 'EH_ButtonID.LD' dis=1 ref')
if EH_EventDay.EH_CurrentEntry == 'LD' then do
call ToPIPE('EH', 'id 'EH_ButtonID.LD' s=0 ref')
EH_EventDay.EH_CurrentEntry = 1
call ToPIPE('EH', 'id 'EH_ButtonID.1' s=1 ref')
EH_DayShowing = 1
end
call ToPIPE('EH', 'id 'EH_HLTypeGad' dis=0 ref')
call ToPIPE('EH', 'id 'EH_WeekNumberGad' dis=1 ref')
call ToPIPE('EH', 'id 'EH_WeekTypeGad' dis=0 ref')
call ToPIPE('EH', 'id 'EH_WeekendGad' dis=1 ref')
call ToPIPE('EH', 'id 'EH_HolidayGad' dis=0 ref')
return
/**/
/***//*** EH_CASetEvent ***/
EH_CASetEvent:
EH_CurrentEntry = EH_Pointer.EH_CurrentPointer
call EH_CASetPrevAndNext
if EH_SelectMonth < 14 then do
/* De-select existing date button */
if EH_DayShowing ~= 0 then call ToPIPE('EH', 'id 'EH_ButtonID.EH_DayShowing' s=0 ref')
/* Select current date button */
EH_EventDay = EH_EventDay.EH_CurrentEntry
EH_DayShowing = EH_EventDay
EH_HighlightType = EH_HighlightType.EH_CurrentEntry
call ToPIPE('EH', 'id 'EH_ButtonID.EH_EventDay' s=1')
call ToPIPE('EH', 'id 'EH_HLTypeGad' s='EH_HighlightType.EH_CurrentEntry)
if EH_HighlightType.EH_CurrentEntry == 0 then call EH_CASetFixedGads
else if EH_HighlightType.EH_CurrentEntry == 1 then do
call EH_CASetFloatGads
call EH_CACheckWeekNumber
end
else if EH_HighlightType.EH_CurrentEntry == 2 then do
call EH_CASetBiOrWeeklyGads
call EH_CACheckWeekType
end
call ToPIPE('EH', 'id 'EH_WeekendGad' s='EH_Weekend.EH_CurrentEntry)
call ToPIPE('EH', 'id 'EH_HolidayGad' s='EH_Holiday.EH_CurrentEntry' ref')
end
else call ToPIPE('EH', 'id 'EH_EasterGad' defn='EH_Easter.EH_CurrentEntry)
call ToPIPE('EH', 'id 'EH_EventGad' gt="'EH_Event.EH_CurrentEntry'" ref')
call ToPIPE('EH', 'id 'EH_CommentGad' gt="'EH_Comment.EH_CurrentEntry'" ref')
call ToPIPE('EH', 'id 'EH_ColorGad' gt="'EH_Color.EH_CurrentEntry'" ref')
return
/**/
/***//*** EH_CASetFixedGads ***/
EH_CASetFixedGads:
call ToPIPE('EH', 'id 'EH_ButtonID.LD' dis=0 ref')
call ToPIPE('EH', 'id 'EH_ColorGad' dis=0 ref')
call ToPIPE('EH', 'id 'EH_HLTypeGad' dis=0 ref')
call ToPIPE('EH', 'id 'EH_WeekNumberGad' dis=1 ref')
call ToPIPE('EH', 'id 'EH_WeekTypeGad' dis=1 ref')
call ToPIPE('EH', 'id 'EH_WeekendGad' dis=0 ref')
call ToPIPE('EH', 'id 'EH_HolidayGad' dis=0 ref')
call ToPIPE('EH', 'id 'EH_EasterGad' dis=1 ref')
return
/**/
/***//*** EH_CASetFloatGads ***/
EH_CASetFloatGads:
call ToPIPE('EH', 'id 'EH_ButtonID.LD' dis=1 ref')
if EH_EventDay.EH_CurrentEntry == 'LD' then do
call ToPIPE('EH', 'id 'EH_ButtonID.LD' s=0 ref')
EH_EventDay.EH_CurrentEntry = 1
call ToPIPE('EH', 'id 'EH_ButtonID.1' s=1 ref')
EH_DayShowing = 1
end
call ToPIPE('EH', 'id 'EH_ColorGad' dis=0 ref')
call ToPIPE('EH', 'id 'EH_HLTypeGad' dis=0 ref')
call ToPIPE('EH', 'id 'EH_WeekNumberGad' dis=0 ref')
call ToPIPE('EH', 'id 'EH_WeekTypeGad' dis=1 ref')
call ToPIPE('EH', 'id 'EH_WeekendGad' dis=1 ref')
call ToPIPE('EH', 'id 'EH_HolidayGad' dis=0 ref')
call ToPIPE('EH', 'id 'EH_EasterGad' dis=1 ref')
return
/**/
/***//*** EH_CASetMonthGads ***/
EH_CASetMonthGads:
call ToPIPE('EH', 'id 'EH_EventGad' dis=0 ref')
call ToPIPE('EH', 'id 'EH_ChooseEventGad' dis=0 ref')
call ToPIPE('EH', 'id 'EH_CommentGad' dis=0 ref')
call ToPIPE('EH', 'id 'EH_ColorGad' dis=0 ref')
if EH_SelectMonth == 14 then do
EH_DisableFlag = 1
call ToPIPE('EH', 'id 'EH_HLTypeGad' dis=1 ref')
call ToPIPE('EH', 'id 'EH_WeekNumberGad' dis=1 ref')
call ToPIPE('EH', 'id 'EH_WeekTypeGad' dis=1 ref')
call ToPIPE('EH', 'id 'EH_WeekendGad' dis=1 ref')
call ToPIPE('EH', 'id 'EH_EasterGad' dis=0 ref')
end
else do
call ToPIPE('EH', 'id 'EH_EasterGad' dis=1 ref')
EH_DisableFlag = 0
end
do EH_Posn = 0 to 41
if GadText.EH_Posn ~= '' then call ToPIPE('EH', 'id 'GadID.EH_Posn' dis='EH_DisableFlag' ref')
end
call ToPIPE('EH', 'id 'EH_HolidayGad' dis=0 ref')
call ToPIPE('EH', 'id 'EH_DeleteEventGad' dis=0 ref')
return
/**/
/***//*** EH_CASetPrevAndNext ***/
EH_CASetPrevAndNext:
if EH_EntryCount < 2 then do
call ToPIPE('EH', 'id 'EH_ListEventGad' dis=1')
call ToPIPE('EH', 'id 'EH_CycleEventGad' dis=1')
end
else do
call ToPIPE('EH', 'id 'EH_ListEventGad' dis=0 ref')
call ToPIPE('EH', 'id 'EH_CycleEventGad' dis=0 ref')
end
return
/**/
/***//*** EH_CASetRequester ***/
call EH_CASetRequester:
call ToPIPE('EH', 'id 0 s=256')
if EH_DayShowing ~= 0 then call ToPIPE('EH', 'id 'EH_ButtonID.EH_DayShowing' s=0 ref')
EH_DayShowing = 0
EH_ShortMonth = EH_SelectMonth - 0
if EH_ShortMonth > 12 then EH_ShortMonth = 1
EH_Month = right(EH_ShortMonth, 2, "0")
interpret 'EH_StartDate = Day.'DateInfo('W', EH_Year''EH_Month'01', 'S')
MonthLength.2 = 29
call ToPIPE('EH', 'id 'EH_MonthGad' s='EH_SelectMonth - 1)
if EH_SelectMonth ~= 14 then do
EH_ButtonID. = 0
EH_GadText. = ''
EH_Day = 0
do EH_Week = 0 to 5
do EH_WeekDay = 0 to 6
EH_Posn = (EH_Week * 7) + EH_WeekDay
if (EH_Posn >= EH_StartDate) & (EH_Posn < EH_StartDate + MonthLength.EH_ShortMonth + 1) then do
EH_Day = EH_Day + 1
if EH_Day > MonthLength.EH_ShortMonth then EH_Day = LD
GadText.EH_Posn = EH_Day
EH_ButtonID.EH_Day = GadID.EH_Posn
interpret 'EH_Day.'GadID.EH_Posn' = EH_Day'
call ToPIPE('EH', 'id 'GadID.EH_Posn' gt="'EH_Day'" dis=0')
end
else do
GadText.EH_Posn = ''
interpret 'drop EH_Day.'GadID.EH_Posn
call ToPIPE('EH', 'id 'GadID.EH_Posn' gt="" dis=1')
end
end
end
end
if UpdateBusy(Req, 1) == -1 then call EH_CACleanup
call EH_CAReadData
if UpdateBusy(Req, 1) == -1 then call EH_CACleanup
EH_DayShowing = 0
if EH_EntryCount > 0 then do
call EH_CASetMonthGads
call EH_CASetEvent
end
else call EH_CAGhostGads
call ToPIPE('EH', 'id 0 s=512')
return
/**/
/***//*** EH_CASortAndFind ***/
EH_CASortAndFind:
parse arg SAF_CurrentEntry
SortFile = ''
do EH_i = 1 to EH_EntryCount
SortFile = SortFile''right(EH_i, 3, "0")' 'EH_EventDay.EH_i||'0a'x
end
call writefile('pipe:FWC', strip(SortFile, 'B', '0a'x))
address command 'sort pipe:FWC Pipe:FWC1 Colstart 5 numeric'
SortedFile = ReadFile('pipe:FWC1')
call openv('SortedFile')
do EH_i = 1 to EH_EntryCount
EH_Pointer.EH_i = left(readvln('SortedFile'), 3) - 0
if EH_Pointer.EH_i == SAF_CurrentEntry then EH_CurrentPointer = EH_i
end
call closev('SortedFile')
call EH_CAUpdateEventList
call EH_CASetPrevAndNext
return
/**/
/***//*** EH_CAUpdateEventList ***/
EH_CAUpdateEventList:
EH_EventList = ''
do UEL_i = 1 to EH_EntryCount
EH_Entry = EH_Pointer.UEL_i
EH_EventList = EH_EventList'|'EH_Event.EH_Entry
end
EH_EventList = strip(EH_EventList, 'L', '|')
call ToPipe('EH', 'id 'EH_ListEventGad' defn='EH_EntryCount' cl="'EH_EventList'"')
return
/**/
/**/
/**/
/***//*** FilePart (PROCEDURE) ***/
FilePart: PROCEDURE
parse arg FileWithPath
return substr(FileWithPath, max(lastpos(':', FileWithPath), lastpos('/', FileWithPath)) + 1)
/**/
/***//*** GetAppColors () ***/
GetAppColors:
if App == 'FW' then do
FWPrefs = ReadFile(CurrentDir'FWFiles/FW.Prefs')
ColorTable = pos('SWCL', FWPrefs) + 12
EndTable = pos('STUP', FWPrefs)
ColorCount = 0
Do CTPos = ColorTable to EndTable by 20
ColorRegister.ColorCount = c2x(substr(FWPrefs, CTPos - 3, 3))
ColorList.ColorCount = strip(substr(FWPrefs, CTPos, 16), 'B', '00'x)
NCColorList.ColorCount = ColorList.ColorCount
if ColorRegister.ColorCount = '000000' then Black$ = ColorList.ColorCount
if ColorRegister.ColorCount = 'FFFFFF' then White$ = ColorList.ColorCount
ColorCount = ColorCount + 1
end
NCColorCount = ColorCount
NCColorList.COUNT = NCColorCount
ColorList.ColorCount = '<'Clear$'>'
ColorCount = ColorCount + 1
ColorList.COUNT = ColorCount
if symbol('Black$') == 'LIT' then do
call AddMsg('W', "The color black can't be found; "ColorList.0" used instead.")
Black$ = ColorList.0
end
if symbol('White$') == 'LIT' then do
call AddMsg('W', "The color white can't be found; "ColorList.1" used instead.")
White$ = ColorList.1
end
end
else if App == 'PGS' then do
GETFONTLIST FontList
FontList.COUNT = result
PGSColors = ReadFile(CurrentDir''PgmName'.colors')
ColorCount = 0
StartTag = pos('TG'||'00'x, PGSColors)
do while StartTag ~= 0
Color = substr(PGSColors, StartTag + 10, c2d(substr(PGSColors, StartTag + 9, 1)))
AccentMarker = pos(d2c(129), Color)
do while AccentMarker > 0
Color = overlay(d2c(c2d(substr(Color, AccentMarker + 1, 1)) + 128), delstr(Color, AccentMarker, 1), AccentMarker)
AccentMarker = pos(d2c(129), Color)
end
ColorList.ColorCount = Color
NCColorList.ColorCount = ColorList.ColorCount
ColorCount = ColorCount + 1
StartTag = pos('TG'||'00'x, PGSColors, StartTag + 10)
end
NCColorCount = ColorCount
NCColorList.COUNT = NCColorCount
ColorList.ColorCount = '<'Clear$'>'
ColorCount = ColorCount + 1
ColorList.COUNT = ColorCount
White$ = ColorList.0
Black$ = ColorList.1
end
DefaultColor = Black$
DefaultBackground = White$
return
/**/
/***//*** GetFontWidth (GFW) ***/
GetFontWidth:
parse arg GFW_FontType, GFW_FontStyle, GFW_Char
GFW_ID = PrintText(.5, .5, GFW_FontType, GFW_FontStyle, Black$, Width.GFW_FontType, GFW_Char)
if App == 'FW' then do
REDRAW
GETOBJECTCOORDS GFW_ID; parse var RESULT . . . GFW_Width .
DELETEOBJECT GFW_ID
end
else if App == 'PGS' then do
GETTEXTOBJ POSITION GFW_Text OBJECTID GFW_ID WINDOW winName
GFW_Width = GFW_Text.Right - GFW_Text.Left
DELETEOBJECT OBJECTID GFW_ID WINDOW winName
end
return GFW_Width
/**/
/***//*** GetHeight (GH) ***/
GetHeight:
parse arg GH_FontType
if App == 'FW' then do
TEXTBLOCKTYPEPREFS SIZE FSize.GH_FontType FONT Font.GH_FontType
DRAWTEXTBLOCK 1 1 1 'A'; GH_id = result
GETOBJECTCOORDS GH_id; Parse Var result . . . . GH_Text.Height
end
else if App == 'PGS' then do
DRAWTEXTOBJ 0 0 WINDOW winName; GH_id = result
SELECTTEXT AT 0 0 WINDOW winName
BEGINCOMMANDCAPTURE
SETLEADING RELATIVE 100
SETTYPESIZE FSize.GH_FontType WINDOW winName
SETFONT Font.GH_FontType WINDOW winName
ENDCOMMANDCAPTURE
INSERT 'A' WINDOW winName
GETTEXTOBJ POSITION GH_Text OBJECTID GH_id WINDOW winName
GH_Text.Height = GH_Text.Bottom - GH_Text.Top
DELETEOBJECT OBJECTID GH_id WINDOW winName
end
return GH_Text.Height
/**/
/***//*** GetID (GI) ***/
GetID:
parse arg GI_var
return id.GI_var
/**/
/***//*** GetMaxWidth (GMW) ***/
GetMaxWidth:
parse arg GMW_Stem, GMW_Count
GMW_maxwidth = 0
if App == 'FW' then do
do GMW_i = 0 to GMW_Count
interpret 'GMW_ObjectID = 'GMW_Stem'.'GMW_i
GETOBJECTCOORDS GMW_ObjectID
Parse Var result . . . GMW_width .
GMW_maxwidth = max(GMW_width, GMW_maxwidth)
end
end
else if App == 'PGS' then do
do GMW_i = 0 to GMW_Count
interpret 'GMW_ObjectID = 'GMW_Stem'.'GMW_i
SELECTOBJECT ObjectID GMW_ObjectID WINDOW winName
GETTEXTOBJ POSITION GMW_Temp OBJECTID GMW_ObjectID WINDOW winName
GMW_width = GMW_Temp.Right - GMW_Temp.Left
GMW_maxwidth = max(GMW_width, GMW_maxwidth)
end
end
return GMW_maxwidth
/**/
/***//*** GetMiniMax (GMM) ***/
GetMiniMax:
parse arg GMM_FontType
NormalWidth.Widest = 0
BoldWidth.Widest = 0
do GMM_i = 0 to 9
NormalWidthID.GMM_i = PrintText(1, 1, GMM_FontType, 'N', Black$, Width.GMM_FontType, GMM_i)
BoldWidthID.GMM_i = PrintText(1, 1, GMM_FontType, 'B', Black$, Width.GMM_FontType, GMM_i)
end
if App == 'FW' then REDRAW
do GMM_i = 0 to 9
NormalWidth.GMM_i = GetWidth(NormalWidthID.GMM_i)
BoldWidth.GMM_i = GetWidth(BoldWidthID.GMM_i)
NormalWidth.Widest = max(NormalWidth.Widest, NormalWidth.GMM_i)
BoldWidth.Widest = max(BoldWidth.Widest, BoldWidth.GMM_i)
if App == 'PGS' then do
DELETEOBJECT OBJECTID NormalWidthID.GMM_i WINDOW winName
DELETEOBJECT OBJECTID BoldWidthID.GMM_i WINDOW winName
end
end
return
/**/
/***//*** GetPhases (GP) ***/
GetPhases:
parse arg GP_Y, GP_Month
if DateLib == 1 then do
GP_Phase.0 = 'N'
GP_Phase.1 = '1'
GP_Phase.2 = 'F'
GP_Phase.3 = '3'
GP_JD = date_GregorianToJD(1, GP_Month, GP_Y)
do GP_SeqDate = GP_JD - 22 to GP_JD + 39
call date_JDToGregorian(GP_SeqDate, 'GP_DAY GP_MONTH GP_YEAR')
do GP_Phase = 0 to 3
GP_SeqDate = date_GregorianMoonPhase(GP_Day, GP_Month, GP_Year, GP_Phase)
call date_JDToGregorian(GP_SeqDate, 'GP_DAY GP_MONTH GP_YEAR')
MoonPhase.GP_Year.GP_Month.GP_Day = GP_Phase.GP_Phase
end
end
end
else do
/* Routine to determine the dates of the new and full moons for a given year */
/* obtained from the Sky & Telescope web site. The basic program from which */
/* the following was derived originally appeared in Astronomical Computing, */
/* Sky & Telescope, March, 1985 */
GP_R1 = PI(0) / 180
GP_NextPhase = 29.530588853 / 4
GP_U = 0
GP_K0 = trunc((GP_Y - 1900) * 12.3685)
GP_T = (GP_Y - 1899.5) / 100
GP_T2 = GP_T*GP_T
GP_T3 = GP_T*GP_T*GP_T
GP_J0 = 2415020 + 29 * GP_K0
GP_F0 = 0.0001178 * GP_T2 - 0.000000155 * GP_T3 + 0.75933 + 0.53058868 * GP_K0 - 0.000837 * GP_T - 0.000335 * GP_T2
GP_J0 = GP_J0 + trunc(GP_F0)
GP_F0 = GP_F0 - trunc(GP_F0)
GP_M0 = GP_K0 * 0.08084821133
GP_M0 = 360 * (GP_M0 - trunc(GP_M0)) + 359.2242 - 0.0000333 * GP_T2 - 0.00000347 * GP_T3
GP_M1 = GP_K0 * 0.07171366128
GP_M1 = 360 * (GP_M1 - trunc(GP_M1)) + 306.0253 + 0.0107306 * GP_T2 + 0.00001236 * GP_T3
GP_B1 = GP_K0 * 0.08519585128
GP_B1 = 360 * (GP_B1 - trunc(GP_B1)) + 21.2964 - 0.0016528 * GP_T2 - 0.00000239 * GP_T3
do GP_K9 = 0 to 28
GP_J = GP_J0 + 14 * GP_K9
GP_F = GP_F0 + 0.765294 * GP_K9
GP_K = GP_K9 / 2
GP_M5 = (GP_M0 + GP_K * 29.10535608) * GP_R1
GP_M6 = (GP_M1 + GP_K * 385.81691806) * GP_R1
GP_B6 = (GP_B1 + GP_K * 390.67050646) * GP_R1
GP_F = GP_F - 0.4068 * SIN(GP_M6) + (0.1734 - 0.000393 * GP_T) * SIN(GP_M5) + 0.0161 * SIN(2 * GP_M6)
GP_F = GP_F + 0.0104 * SIN(2 * GP_B6) - 0.0074 * SIN(GP_M5 - GP_M6) - 0.0051 * SIN(GP_M5 + GP_M6)
GP_F = GP_F + 0.0021 * SIN(2 * GP_M5) + 0.0010 * SIN(2 * GP_B6 - GP_M6)
GP_J = GP_J + trunc(GP_F)
GP_F = GP_F - trunc(GP_F)
GP_Converted = ConvertJ(GP_F, GP_J)
GP_Y = word(GP_Converted, 1) - 0
GP_M = word(GP_Converted, 2) - 0
GP_Day = word(GP_Converted, 3) - 0
GP_Hrs = word(GP_Converted, 4)
if GP_U = 0 then do
MoonPhase.GP_Y.GP_M.GP_Day = 'N'
GP_FQ = DateInfo('S', trunc(DateInfo('I', GP_Y''right(GP_M, 2, '0')''right(GP_Day, 2, '0'), 'S') + GP_Hrs + GP_NextPhase))
GP_Y = left(GP_FQ, 4)
GP_M = strip(substr(GP_FQ, 5, 2), 'L', '0')
GP_Day = strip(right(GP_FQ, 2), 'L', '0')
MoonPhase.GP_Y.GP_M.GP_Day = '1'
end
if GP_U = 1 then do
MoonPhase.GP_Y.GP_M.GP_Day = 'F'
GP_TQ = DateInfo('S', trunc(DateInfo('I', GP_Y''right(GP_M, 2, '0')''right(GP_Day, 2, '0'), 'S') + GP_Hrs + GP_NextPhase))
GP_Y = left(GP_TQ, 4)
GP_M = strip(substr(GP_TQ, 5, 2), 'L', '0')
GP_Day = strip(right(GP_TQ, 2), 'L', '0')
MoonPhase.GP_Y.GP_M.GP_Day = '3'
end
GP_U = GP_U + 1
if GP_U = 2 then GP_U = 0
end
end
return 0
/**/
/***//*** GetSetupInfo (GSI) ***/
GetSetupInfo:
if exists(ScriptDir'FWC.dat') then call ConvertChangesFile
else do
PrefsFile = ReadFile('ENV:FWCalendar') /* Determine existing data file */
if (PrefsFile == '') | (exists(PrefsFile) == 0) then do
/* Create environment variable if it doesn't exist */
PrefsFile = 'Default'
call WriteFile('ENV:FWCalendar', PrefsFile, 'B')
end
end
if PrefsFile ~= 'Default' then do
GSI_Data = ReadFile(PrefsFile)
GSI_UpperData = upper(GSI_Data)
interpret ReadToEOL(pos('STORAGE', GSI_UpperData), GSI_UpperData)
interpret ReadToEOL(pos('FORCEBGUI', GSI_UpperData), GSI_UpperData)
interpret ReadToEOL(pos('HOSTSCREEN', GSI_UpperData), GSI_UpperData)
if (ForceBGUI == 1) & (RexxBGUILib ~= 1) then call AddBGUI
if HostScreen ~= '' then AppScreen = HostScreen
end
call GetAppColors
if App == 'PGS' then do
GETDOCUMENTS dummy; DocCount = result
if DocCount > 0 then do
CLOSEDOCUMENT ALERT
GETDOCUMENTS dummy; DocCount = result
end
end
if ClassAct == 1 then Req = OpenBusy(PrepReq$, 21 + (ColorList.Count - 1))
else Req = OpenBusy(PrepReq$, 14)
Year = left(date('S'),4)
ThisMonth = left(date('U'), 2) + 0
if (owner == 'rgoertz') & (CallHost == 'REXX') then CalMonth = ThisMonth
else do
CalMonth = getclip('FWC_CalMonth')
if datatype(CalMonth) == 'CHAR' then do
CalMonth = ThisMonth
AddYear = 0
end
else do
CalMonth = CalMonth + 1
if CalMonth = 13 then do
CalMonth = 1
AddYear = 1
end
else AddYear = 0
end
CalYear = getclip('FWC_CalYear')
if (CalYear ~= '') & (DataType(CalYear) == 'NUM') then Year = CalYear + AddYear
end
if UpdateBusy(Req, 1) == -1 then call Cleanup
call InitializeVariables
if UpdateBusy(Req, 1) == -1 then call Cleanup
address command 'makedir >NIL: 'left(Storage, length(Storage) - 1)
if UpdateBusy(Req, 1) == -1 then call Cleanup
WarningsSoFar = WarningCount
if ClassAct == 1 then call DoSetupReq_CA
else do
do until Reset == 0
if Req == 0 then Req = OpenBusy(PrepReq$, 11)
WarningCount = WarningsSoFar
call ReadData
if UpdateBusy(Req, 1) == -1 then call Cleanup
call DoSetupReq_BGUI
if Reset > 0 then call bguiwinclose(winID)
if Reset == 2 then call CleanUp
end
end
Year = EnteredYear
if ImageClass.0 ~= '' then do
do GSI_i = 0 to ImageClass.Count - 1
parse var ImageFile.GSI_i ImageFile.GSI_i ',' GSI_DX ',' GSI_DY
GSI_DX = strip(GSI_DX, 'B', '" '||"'");if GSI_DX == '' then GSI_DX = 0
GSI_DY = strip(GSI_DY, 'B', '" '||"'");if GSI_DY == '' then GSI_DY = 0
if (pos('/', ImageFile.GSI_i) == 0) & (pos(':', ImageFile.GSI_i) == 0) then
ImageFile.GSI_i = ScriptDir'Images/'strip(ImageFile.GSI_i, 'B', ' "'||"'")
ImageDX.GSI_i = GSI_DX
ImageDY.GSI_i = GSI_DY
end
end
call WriteData
if ClassAct == 1 then call close('CA')
else call bguiwinclose(winID)
interpret 'GfxCmd = GfxCmd.'GfxApp
interpret 'GfxTemplate = GfxTemplate.'GfxApp
return
/**/
/***//*** GetSRSS (GS) ***/
GetSRSS:
parse arg GS_IDay
GS_EDay = translate(DateInfo('E', GS_IDay, 'I'), '-', '/')
if AdjustDST ~= 0 then do
if GS_IDay < StartDST | GS_IDay >= EndDST then GS_Status = WriteFile('ENV:suncalc/dst', 0)
else GS_Status = WriteFile('ENV:suncalc/dst', 1)
end
address command Storage'suncalc > 'Storage'SRSS.txt date='GS_EDay' text="$SR $SS"'
return ReadFile(Storage'SRSS.txt')
/**/
/***//*** GetWidth (GW) ***/
GetWidth:
parse arg GW_ID
if App == 'FW' then do
GETOBJECTCOORDS GW_ID
Parse Var result . . . GW_width .
end
else if App == 'PGS' then do
SELECTOBJECT OBJECTID GW_ID WINDOW winName
GETTEXTOBJ POSITION GW_Temp OBJECTID GW_ID WINDOW winName
GW_width = GW_Temp.Right - GW_Temp.Left
end
return GW_width
/**/
/***//*** HalveBox (HB) ***/
HalveBox:
parse arg HB_ID
if App == 'FW' then do
GETOBJECTCOORDS HB_ID
parse var result . HB_Left HB_Top HB_Width HB_Height
SETOBJECTCOORDS HB_ID 1 HB_Left HB_Top HB_Width HB_Height/2
end
else if App == 'PGS' then do
GETBOX POSITION HB_Coords OBJECTID HB_ID WINDOW winName
HB_Bottom = HB_Coords.Top + (HB_Coords.Bottom - HB_Coords.Top) / 2
EDITBOX POSITION HB_Coords.Left HB_Coords.Top HB_Coords.Right HB_Bottom OBJECTID HB_ID WINDOW winName
end
return HB_ID
/**/
/***//*** PgmVer (PROCEDURE) ***/
PgmVer: PROCEDURE
parse arg Program
address command 'version 'Program '>PIPE:FWC file'
return strip(word(ReadFile('PIPE:FWC'), 2))
/**/
/***//*** MemberID (MI) ***/
MemberID:
parse arg MI_Member, MI_Array, MI_Count, MI_Start
if MI_Count == '' then interpret 'MI_Count = 'MI_Array'.Count'
if MI_Start == '' then do
if symbol(MI_Array'.Start') == 'VAR' then interpret 'MI_Start = 'MI_Array'.Start'
else MI_Start = 0
end
do MI_i = MI_Start to MI_Start + MI_Count - 1
if upper(value(MI_Array'.'MI_i)) == upper(MI_Member) then return MI_i
end
return -1
/**/
/***//*** MiniCalPreCalc (MCPC) ***/
MiniCalPreCalc:
parse arg MCPC_FontType, MCPC_CalWidth
Width.MCPC_FontType = 100 * min(1, MCPC_CalWidth / (22 * BoldWidth.Widest))
if App == 'FW' then Width.MCPC_FontType = trunc(Width.MCPC_FontType)
do MCPC_i = 0 to 9
NormalWidth.MCPC_i = NormalWidth.MCPC_i * Width.MCPC_FontType / 100
BoldWidth.MCPC_i = BoldWidth.MCPC_i * Width.MCPC_FontType / 100
end
NormalWidth.Widest = NormalWidth.Widest * Width.MCPC_FontType / 100
BoldWidth.Widest = BoldWidth.Widest * Width.MCPC_FontType / 100
return
/**/
/***//*** ParseVariables (PV) ***/
ParseVariables:
parse arg PV_Line
PV_String = translate(PV_Line,,'=(+-*/,)"'||"'",' ')
PV_VarString = ''
PV_Var. = '00'x
PV_LongVar = 4
PV_LIT = ''
PV_Count = 0
do PV_i = 1 to words(PV_String)
PV_Word = word(PV_String, PV_i)
if pos(PV_Word'(', PV_Line) > 0 then iterate
if datatype(PV_Word) == 'CHAR' then do
if (symbol(PV_Word) == 'LIT') then PV_LIT = PV_LIT''PV_Word', '
if (symbol(PV_Word) == 'VAR') | (pos('.', PV_Word) > 0) then do
if symbol(PV_Word) == 'VAR' then do
PV_LongVar = max(PV_LongVar, length(PV_Word) + 2)
if PV_Var.PV_Word == '00'x then do
PV_Count = PV_Count + 1
PV_Var.PV_Count = PV_Word
PV_Var.PV_Word = value(PV_Word)
end
end
if pos('.', PV_Word) > 0 then do
PV_CompoundParts = subword(translate(PV_Word,,'.', ' '), 2)
do PV_j = 1 to words(PV_CompoundParts)
PV_Subword = word(PV_CompoundParts, PV_j)
PV_LongVar = max(PV_LongVar, length(PV_SubWord) + 2)
if PV_Var.PV_SubWord == '00'x then do
PV_Count = PV_Count + 1
PV_Var.PV_Count = PV_SubWord
if symbol(PV_Subword) == 'LIT' then PV_Var.PV_SubWord = 'LIT'
else PV_Var.PV_SubWord = value(PV_SubWord)
end
end
end
end
end
end
do PV_i = 1 to PV_Count
PV_Word = PV_Var.PV_i
if length(PV_Var.PV_Word) > 50 then PV_Var.PV_Word = left(PV_Var.PV_Word, 50)'...'
PV_Var.PV_Word = translate(PV_Var.PV_Word,,'0a'x||'0d'x||'00'x,'bb'x)
PV_VarString = PV_VarString''right(PV_Word, PV_LongVar)' = 'PV_Var.PV_Word||'0a'x
end
if PV_LIT ~= '' then PV_VarString = right('LIT', PV_LongVar)' = 'strip(PV_LIT, 'B', ' ,')||'0a'x||PV_VarString
return PV_VarString
/**/
/***//*** PathPart (PROCEDURE) ***/
PathPart: PROCEDURE
parse arg FileWithPath
return left(FileWithPath, max(lastpos(':', FileWithPath), lastpos('/', FileWithPath)))
/**/
/***//*** Pi (PROCEDURE) ***/
Pi:
return 3.1415926536
/**/
/***//*** PrintHighlight (PH) ***/
PrintHighlight:
parse arg PH_Event, PH_Type
PH_Type = upper(PH_Type)
MaxCompression = MinWidth / 100
CenterText = 0
if PH_Type ~= 'HIGHLIGHT' then do
HighlightOffset = 0
if PH_Type == 'RANDOM' then do
MaxCompression = MinRandomWidth / 100
if BackgroundColor == '<'Clear$'>' then TextColor = Color.Random
else TextColor = AltColor.Random
CenterText = CenterRandom
end
if PH_Type == 'HISTORY' then do
MaxCompression = MinHistoryWidth / 100
if BackgroundColor == '<'Clear$'>' then TextColor = Color.History
else TextColor = AltColor.History
CenterText = CenterHistory
end
end
/* Fit line(s) into allowable space */
PH_Textline = 0
PH_Text. = ''
PH_Text.PH_Textline = PH_Event
Do until PH_Text.PH_Nextline == ''
PH_AllowedWidth = BoxWidth - 2 * CurveOffset - HighlightOffset
PH_Nextline = PH_Textline + 1
if PH_Textline == 0 then PH_Indent.PH_Textline = 0
else PH_Indent.PH_Textline = Width.WidthOfDate1
if (PH_Type == 'RANDOM') | (PH_Type == 'HISTORY') then PH_Indent.PH_Textline = 0
PH_AllowedWidth = PH_AllowedWidth - PH_Indent.PH_Textline
if PH_Event == '' then do
PH_Text.PH_TextLine = ''
iterate
end
if App == 'FW' & length(PH_Text.PH_Textline) > 37 then do
PH_Wordbreak = lastpos(' ', PH_Text.PH_Textline, 37)
PH_Text.PH_Nextline = strip(substr(PH_Text.PH_Textline, PH_Wordbreak)' 'PH_Text.PH_Nextline)
PH_Text.PH_Textline = strip(left(PH_Text.PH_Textline, PH_Wordbreak))
end
PH_ID = PrintText(1, 1, Highlight, 'N', Color.Highlight, Width.Highlight, PH_Text.PH_Textline)
if App == 'FW' then redraw
PH_TextWidth.PH_Textline = GetWidth(PH_ID)
if App == 'FW' then DELETEOBJECT PH_ID
else if App == 'PGS' then do
SELECTOBJECT ObjectID PH_ID WINDOW winName
DELETEOBJECT ObjectID PH_ID WINDOW winName
end
PH_NeededCompression.PH_Textline = min(1, PH_AllowedWidth/PH_TextWidth.PH_Textline)
if (PH_NeededCompression.PH_Textline < MaxCompression) & (Words(PH_Text.PH_Textline) > 1) then do
/* Move last word to next line */
PH_Wordbreak = lastpos(' ', PH_Text.PH_Textline)
PH_Text.PH_Nextline = strip(substr(PH_Text.PH_Textline, PH_Wordbreak)' 'PH_Text.PH_Nextline)
PH_Text.PH_Textline = strip(left(PH_Text.PH_Textline, PH_Wordbreak))
end
else if PH_Text.PH_Nextline ~= '' then PH_Textline = PH_Textline + 1
end
if PH_Text.0 ~= '' then do
PH_LineCount = PH_Textline
MaxCompression = 1
do PH_i = 0 to PH_LineCount
MaxCompression = min(MaxCompression, PH_NeededCompression.PH_i)
end
PH_Width = MaxCompression * Width.Highlight
if App == 'FW' then PH_Width = min(max(trunc(PH_Width), 4), 255)
if (PH_Type == 'RANDOM') | (PH_Type == 'HISTORY') then DailyHLCount = HighlightRows - PH_LineCount - 1
do PH_TextLine = 0 to PH_LineCount
if PH_Text.PH_TextLine ~= '' then do
TextLeft = BoxLeft + CurveOffset + HighlightOffset * (DailyHLCount * Height.Highlight < Height.Date * TextBase)
PH_TextTop = BoxTop + DailyHLCount * Height.Highlight
if (BHeight == BoxHeight/2) & (PH_Type ~= 'HIGHLIGHT') then PH_TextTop = PH_TextTop - BHeight
if CenterText == 0 then call PrintText(TextLeft + PH_Indent.PH_TextLine, PH_TextTop, Highlight, 'N', TextColor, PH_Width, PH_Text.PH_TextLine)
else call CenterText(PrintText(TextLeft + PH_Indent.PH_TextLine, PH_TextTop, Highlight, 'N', TextColor, PH_Width, PH_Text.PH_TextLine), BoxLeft + BoxWidth / 2, 0, 1)
end
if PH_TextLine ~= PH_LineCount then DailyHLCount = DailyHLCount + 1
end
end
return
/**/
/***//*** PrintOption (PO) ***/
PrintOption:
parse arg PO_Location
PO_ID = PrintText(BoxLeft + CurveOffset, BoxTop + (BHeight - Height.Extras) * (left(PO_Location, 1) ~= 'T'), Extras, 'N', DO_PrintColor, Width.Extras, DO_Text2Print)
if right(PO_Location, 1) == 'C' then call CenterText(PO_ID, BoxLeft + BoxWidth / 2, 0, min(1, BoxWidth/GetWidth(PO_ID)))
if right(PO_Location, 1) == 'R' then call RightText(PO_ID, BoxLeft + BoxWidth - 2 * CurveOffset)
return PO_ID
/**/
/***//*** PrintText (PT) ***/
PrintText:
parse arg PT_Left, PT_Top, PT_FontType, PT_Style, PT_Color, PT_Width, PT_Text
if upper(PT_Style) == 'N' then PT_Font = Font.PT_FontType
else PT_Font = Bold.PT_FontType
if App == 'FW' then do
if left(PT_Text, 1) == '"' then PT_Text = '""'PT_Text
PT_Top = PT_Top + TextAdj * Height.PT_FontType
TEXTBLOCKTYPEPREFS SIZE FSize.PT_FontType WIDTH trunc(PT_Width) COLOR '"'PT_Color'"' FONT PT_Font
DRAWTEXTBLOCK 1 trunc(PT_Left, 4) trunc(PT_Top, 4) PT_Text; PT_id = result
end
else if App == 'PGS' then do
DRAWTEXTOBJ PT_Left PT_Top WINDOW winName; PT_id = result
SELECTTEXT AT PT_Left PT_Top WINDOW winName
BEGINCOMMANDCAPTURE
SETLEADING RELATIVE 100
SETTYPESIZE FSize.PT_FontType WINDOW winName
SETTYPEWIDTH PT_Width WINDOW winName
SETFONT PT_Font WINDOW winName
SETCOLORSTYLE '"'PT_Color'"' COLORNUMBER 0 FILL TEXT WINDOW winName
ENDCOMMANDCAPTURE
if pos('"', PT_Text) > 0 then do
call WriteFile(Storage'FWCTemp.txt', PT_Text)
INSERTTEXT FILE '"'Storage'FWCTemp.txt"' FILTER ASCII WINDOW winName
end
else INSERT '"'PT_Text'"' WINDOW winName
end
return PT_id
/**/
/***//*** ProcessVariableList (PVL) ***/
ProcessVariableList:
parse arg PVL_DataFile
call openv(PVL_DataFile)
do until eofv(PVL_DataFile)
PVL_Ln = ReadVLn(PVL_DataFile)
if PVL_Ln = '' then iterate /* Skip blank lines */
PVL_VarName = strip(word(PVL_Ln, 1))
PVL_UpperVarName = upper(PVL_VarName)
PVL_VarStem = upper(left(PVL_VarName, pos('.', PVL_VarName)))
VarNameMaxLn = max(VarNameMaxLn, length(PVL_VarName))
if (pos('/* End Pass One', PVL_Ln) > 0) | (PVL_DoHighlights == 1) then do
PVL_DoHighlights = 1
if left(PVL_Ln, 2) == '/*' then iterate
PVL_Month = left(PVL_Ln, 2)
if upper(PVL_Month) == 'CA' then PVL_Month = 14
MonthCount.PVL_Month = MonthCount.PVL_Month + 1
PVL_MonthCount = MonthCount.PVL_Month
HighlightData.PVL_Month.PVL_MonthCount = PVL_Ln
iterate
end
if PVL_VarName == 'return' then leave
if left(PVL_Ln, 2) == '/*' then iterate
if PVL_VarStem == 'IMAGECLASS.' then do
ImageClass.ImgClassCount = substr(PVL_VarName, 12)
PVL_ImageFile = strip(substr(PVL_Ln, pos("=", PVL_Ln) + 1), 'B', " '"||'"')
interpret "ImageFile."ImgClassCount" = PVL_ImageFile"
ImgClassCount = ImgClassCount + 1
iterate
end
interpret PVL_Ln
if (PVL_VarStem == 'ALTCOLOR.') | (PVL_VarStem == 'BACKGROUND.') |,
(PVL_VarStem == 'COLOR.') | (PVL_VarStem == 'LINE.') then do
PVL_VariableType = 'Color'
if (value(PVL_VarName) == '<'Clear$'>') & (PVL_VarStem ~= 'BACKGROUND.') then do
call AddMsg('W', 'Only "Background." variables can be set to <'Clear$'>; 'ColorList.0' used instead.')
interpret PVL_VarName' = 'ColorList.0
end
if (MemberID(value(PVL_VarName), 'ColorList') == -1) then do
call AddMsg('W', value(PVL_VarName)' in "'PVL_Ln'"'" can't be found; "ColorList.0" used instead.")
PVL_Ln = PVL_VarName' = "'ColorList.0'"'
end
end
else if (PVL_VarStem == 'FONT.') | (PVL_VarStem == 'BOLD.') then PVL_VariableType = 'Font'
else if upper(PVL_VarName) == 'DOHIDE' then PVL_VariableType = 'Misc'
else if (PVL_VarStem == 'MARGIN.') | (upper(left(PVL_VarName, 2)) == 'DO') |,
(upper(PVL_VarName) == 'ORIENTATION') then PVL_VariableType = 'Main'
else PVL_VariableType = 'Misc'
if (VariableSeq.PVL_UpperVarName == '') & (RD_VariableType == 'Default') then do
VariableName.VariableCount = PVL_VarName
VariableType.VariableCount = PVL_VariableType
VariableSeq.PVL_UpperVarName = VariableCount
VariableCount = VariableCount + 1
end
end
call closev(PVL_DataFile)
return
/**/
/***//*** QuoteIt (PROCEDURE) ***/
QuoteIt: PROCEDURE
parse arg String
String = strip(String)
if (left(String, 1) == '"') & (right(String, 1) == '"') then return String
else if (left(String, 1) == "'") & (right(String, 1) == "'") then return String
else if pos("'", String) == 0 then return "'"String"'"
else return '"'String'"'
return
/**/
/***//*** ReadBrowserList (RBL) ***/
ReadBrowserList:
parse arg RBL_FileHandle, RBL_GadIDList, RBL_ItemList, RBL_CurrentItem
interpret 'RBL_AlreadyOpen = 'RBL_FileHandle
if RBL_AlreadyOpen == 0 then do
call ToPIPE(RBL_FileHandle, 'open')
if RBL_FileHandle == 'MiscVarReq' then do
do RBL_i = 0 to UpdateVarCmds - 1
GadID = ToPIPE('MiscVarReq', UpdateVarCmd.RBL_i)
interpret 'MiscVarGad.'GadID' = 'UpdateVarNum.RBL_i
end
UpdateVarCmds = 0
end
if RBL_CurrentItem ~= '' then call ToPIPE(RBL_FileHandle, 'id 1 s='MemberID(RBL_CurrentItem, RBL_ItemList) + 2)
interpret RBL_FileHandle '= 1'
end
else do
if RBL_FileHandle == 'MiscVarReq' then do
do RBL_i = 0 to UpdateVarCmds - 1
GadID = ToPIPE('MiscVarReq', UpdateVarCmd.RBL_i)
interpret 'MiscVarGad.'GadID' = 'UpdateVarNum.RBL_i
end
UpdateVarCmds = 0
end
if RBL_CurrentItem ~= '' then call ToPIPE(RBL_FileHandle, 'id 1 s='MemberID(RBL_CurrentItem, RBL_ItemList) + 2)
call ToPIPE(RBL_FileHandle, 'id 0 s=64')
end
do while ~eof(RBL_FileHandle)
call ToPIPE(RBL_FileHandle, 'continue')
RBL_Result = readln(RBL_FileHandle)
parse var RBL_Result . . . . RBL_NodeID
RBL_NodeID = strip(RBL_NodeID)
interpret 'RBL_ListID = 'RBL_GadIDList'.RBL_NodeID'
if pos('gadget', RBL_Result) > 0 then leave
end
call ToPIPE(RBL_FileHandle, 'id 0 s=128')
interpret 'RBL_Entry = 'RBL_ItemList'.'RBL_ListID
return RBL_Entry
/**/
/***//*** ReadCAGad (PROCEDURE) ***/
ReadCAGad: PROCEDURE
parse arg PipeName, GadgetID
call writeln(PipeName, 'id 'GadgetID' read')
return readln(PipeName)
/**/
/***//*** ReadData (RD) ***/
ReadData:
VariableCount = 0
MainVarCount = 0
MiscVarCount = 0
ColorVarCount = 0
FontVarCount = 0
ImgClassCount = 0
VariableName. = ''
VariableSeq. = ''
RD_Progress = -1
VarNameMaxLn = 0
MonthCount. = 0
PVL_DoHighlights = 0
GadSel. = 0
GadDis. = 0
DSR_Sel. = 0
DSR_PSel. = 0
DSR_Dis. = copies('0', PosnCount + 1)
DSR_PDis. = copies('0', PosnCount + 1)
/* Read default variables */
call open('Temp', FullCallPath)
call seek('Temp', -5000, 'E')
Chunk = readch('Temp', 65535)
EndPos = pos('VarList:'||'0a'x, Chunk)
if EndPos == 0 then do
call AddMsg('E', 'Unable to locate default variables.')
call CleanUp
end
RD_VariableFile = substr(Chunk, EndPos + 9)
call close('Temp')
if UpdateBusy(Req, 1) == -1 then call Cleanup
RD_VariableType = 'Default'
call ProcessVariableList('RD_VariableFile')
if UpdateBusy(Req, 1) == -1 then call Cleanup
if App == 'FW' then do
GETSECTIONSETUP Top Bottom Inside Outside
parse var result Margin.Top Margin.Bottom Margin.Left Margin.Right
end
else if App == 'PGS' then do
Margin.Top = 0.5
Margin.Bottom = 0.5
Margin.Left = 0.5
Margin.Right = 0.5
end
do RD_i = 0 to VariableCount - 1
Default.RD_i = value(VariableName.RD_i)
end
/* Read user variables */
if PrefsFile ~= 'Default' then do
RD_VariableFile = ReadFile(PrefsFile)
RD_VariableType = 'User'
if RD_VariableFile ~= '' then call ProcessVariableList('RD_VariableFile')
end
if UpdateBusy(Req, 1) == -1 then call Cleanup
if HostScreen ~= '' then AppScreen = HostScreen
do RD_i = 0 to VariableCount - 1
select
when VariableType.RD_i == 'Color' then do
ColorVarName.ColorVarCount = VariableName.RD_i
ColorVarCount = ColorVarCount + 1
if ClassAct == 1 then ColorVarList = ColorVarList''VariableName.RD_i'|'
end
when VariableType.RD_i == 'Font' then do
FontVarName.FontVarCount = VariableName.RD_i
FontVarCount = FontVarCount + 1
end
when VariableType.RD_i == 'Main' then do
MainVarName.MainVarCount = VariableName.RD_i
MainVarCount = MainVarCount + 1
end
otherwise do
MiscVarName.MiscVarCount = VariableName.RD_i
MiscVarCount = MiscVarCount + 1
if ClassAct == 1 then MiscVarList = MiscVarList''VariableName.RD_i'|'
end
end
end
if UpdateBusy(Req, 1) == -1 then call Cleanup
if ImgClassCount > 0 then do
do RD_i = 0 to ImgClassCount - 1
MiscVarName.MiscVarCount = 'ImageClass.'ImageClass.RD_i
MiscVarCount = MiscVarCount + 1
if ClassAct == 1 then MiscVarList = MiscVarList''MiscVarName.MiscVarCount'|'
end
end
MainVarName.COUNT = MainVarCount
MiscVarName.COUNT = MiscVarCount
ColorVarName.COUNT = ColorVarCount
FontVarName.COUNT = FontVarCount
ImageClass.COUNT = ImgClassCount
CurrentColorName = ColorVarName.0
CurrentFontName = FontVarName.0
CurrentMiscName = MiscVarName.0
if upper(left(CurrentMiscName, 11)) == 'IMAGECLASS.' then do
IC = MemberID(upper(substr(CurrentMiscName, 12)), 'ImageClass')
VarVal = ImageFile.IC
end
else VarVal = Value(CurrentMiscName)
if upper(Orientation) == 'WIDE' then OrientChoice = 0
else OrientChoice = 1
if UpdateBusy(Req, 1) == -1 then call Cleanup
if (exists(SunCalcPath'suncalc')) & (~exists(Storage'suncalc')) then address command 'copy 'SunCalcPath'suncalc 'Storage
if UpdateBusy(Req, 1) == -1 then call Cleanup
if (exists(GfxAppPath''GfxApp)) & (~exists(Storage''GfxApp)) then address command 'copy 'GfxAppPath''GfxApp' 'Storage
if ~exists(Storage''GfxApp) then do
GfxDisable = 1
DoImages = 0
end
else GfxDisable = 0
if PhaseLib ~= 1 then DoPhases = 0
do i = 0 to 6
val = i - StartWeek
if val < 0 then val = 7 + val
interpret 'Day.'D.i '=' val
interpret 'Day.val = 'D.i'$'
end
return
/**/
/***//*** ReadFile (PROCEDURE) ***/
ReadFile: PROCEDURE
parse arg file
if open('Temp', file) then do
val = strip(readch('Temp', 65535), 'B', ' '||'0a'x)
call close('Temp')
end
else val = ''
return val
/**/
/***//*** ReadToEOL (PROCEDURE) ***/
ReadToEOL: PROCEDURE
parse arg Start, Var
if Start == 0 then return ''
EOL = pos('0a'x, Var, Start)
if EOL == 0 then EOL = length(Var) + 1
return substr(Var, Start, EOL - Start)
/**/
/***//*** ReplaceString (RS) ***/
ReplaceString: PROCEDURE
parse arg old, new, string
if pos(old, string) > 0 then do
parse var string begin(old)end
return begin || new || ReplaceString(old, new, end)
end
return string
/**/
/***//*** RightText (RT) ***/
RightText:
parse arg RT_id, RT_RightEdge
if App = 'FW' then do
GETOBJECTCOORDS RT_id; Parse Var result . . RT_Text.Bottom RT_Text.Width RT_Text.Height
RT_Text.Left = RT_RightEdge - RT_Text.Width
SETOBJECTCOORDS RT_id 1 RT_Text.Left RT_Text.Bottom RT_Text.Width RT_Text.Height
end
else if App == 'PGS' then do
GETTEXTOBJ POSITION RT_Text OBJECTID RT_id WINDOW winName
RT_Text.Width = RT_Text.Right - RT_Text.Left
RT_Text.Left = RT_RightEdge - RT_Text.Width
EDITTEXTOBJ POSITION RT_Text.Left RT_Text.Top (RT_Text.Left + RT_Text.Width) RT_Text.Bottom OBJECTID RT_id WINDOW winName
end
return RT_id
/**/
/***//*** SaveVariable (SV) ***/
SaveVariable:
parse arg SV_OutFile, SV_Variable, SV_Value
SV_Cmd = SV_Variable' = 'SV_Value
call WriteLn(SV_OutFile, SV_Cmd)
interpret SV_Cmd
return
/**/
/***//*** SetFill (SF) ***/
SetFill:
parse arg SF_ID, SF_StrokeColor, SF_FillColor
BEGINCOMMANDCAPTURE
SETSTROKEWEIGHT '0.3pt' STROKENUMBER 0 OBJECT OBJECTID SF_ID WINDOW winName
SETCOLORSTYLE '"'SF_StrokeColor'"' STROKENUMBER 0 OBJECT OBJECTID SF_ID WINDOW winName
FILLED 'ON'
SETCOLORSTYLE '"'SF_FillColor'"' FILL OBJECT OBJECTID SF_ID WINDOW winName
ENDCOMMANDCAPTURE
return
/**/
/***//*** SetHighlights (SH) ***/
SetHighlights:
/* The algorithm for calculating Easter is due to J.-M. Oudin (1940) and is */
/* reprinted in the Explanatory Supplement to the Astronomical Almanac, ed. P. K. */
/* Seidelmann (1992). See Chapter 12, "Calendars", by L. E. Doggett. */
/* */
/* I obtained the algorithm from the US Naval Observatory web site */
SettingHighlights = 1
if EasterKnown ~= 1 then do
SH_century = trunc(Year / 100)
SH_n = trunc(Year - 19 * trunc(Year / 19))
SH_k = trunc((SH_century - 17) / 25)
SH_i = SH_century - trunc(SH_century / 4) - trunc((SH_century - SH_k) / 3) + 19 * SH_n + 15
SH_i = SH_i - 30 * trunc(SH_i / 30)
SH_i = SH_i - trunc(SH_i / 28) * (1 - trunc(SH_i / 28) * trunc(29 / (SH_i + 1)) * trunc((21 - SH_n) / 11))
SH_j = Year + trunc(Year / 4) + SH_i + 2 - SH_century + trunc(SH_century / 4)
SH_j = SH_j - 7 * trunc(SH_j / 7)
SH_l = SH_i - SH_j
SH_EasterMonth = 3 + trunc((SH_l + 40 ) / 44)
SH_EasterDay = SH_l + 28 - 31 * trunc(SH_EasterMonth / 4)
EasterSerial = DateInfo('I', Year'0'SH_EasterMonth''right(SH_EasterDay, 2, '0'), 'S')
EasterKnown = 1
end
Highlight. = ''
Image. = ''
if PrefsFile ~= 'Default' then do
call open('DataFile', PrefsFile)
do forever
if eof('DataFile') then leave
if pos('/* End Pass One', readln('DataFile')) > 0 then do
do until eof('DataFile')
SH_Ln = strip(ReadLn('DataFile'))
if right(SH_Ln, 2) == '*/' then SH_Ln = left(SH_Ln, lastpos('/*', SH_Ln) - 1)
SH_Ln2 = left(SH_Ln, 2)
if upper(left(SH_Ln, 14)) == 'CALCULATEEDATE' then interpret 'call 'SH_Ln
if (SH_Ln2 == Mn) | (SH_Ln2 == '13') then do
select
when upper(substr(SH_Ln, 3, 13)) == 'CALCULATEDATE' then interpret 'call 'substr(SH_Ln, 3)
when upper(substr(SH_Ln, 3, 9)) == 'HIGHLIGHT' then call AssignHighlight(substr(SH_Ln, 3))
when upper(substr(SH_Ln, 3, 5)) == 'IMAGE' then call AssignImage(substr(SH_Ln, 3))
when upper(substr(SH_Ln, 3, 14)) == 'CALCULATEIMAGE' then interpret 'call 'substr(SH_Ln, 3)
otherwise do
call AddMsg('W', 'Check the keyword in the following line of your preferences file:')
call AddMsg('W', ' 'SH_Ln)
ListHighlightData = 1
end
end
end
end
end
end
call close('DataFile')
end
SettingHighlights = 0
return
/**/
/***//*** Syntax () ***/
Syntax:
if DoingCleanup == 1 then return
signal off syntax
ErrorLine = SIGL
SourceLine = strip(SourceLine(ErrorLine))
call AddMsg('E', 'Error 'RC' ('errortext(RC)')')
call AddMsg('E', 'Line 'ErrorLine': 'SourceLine)
call AddMsg('E', ParseVariables(SourceLine))
call Cleanup
exit
/**/
/***//*** ToPIPE (TP) ***/
ToPIPE:
parse arg PipeName, TP_CMD
call writeln(PipeName,' 'TP_CMD)
TP_Response=readln(PipeName)
parse var TP_Response TP_Response1 TP_Response2 .
if TP_Response1 == 'ok' then return(TP_Response2)
if TP_Response == '' then TP_Response = 'Blank line'
call AddMsg('E', 'Line : 'SIGL)
call AddMsg('E', PipeName' error: 'TP_Response)
call AddMsg('E', 'Returned from: 'TP_CMD)
call Cleanup
/**/
/***//*** VIO Routines () ***/
/***//** OpenV() **/
OpenV:
parse arg VIO_Variable
if Open.VIO_Variable ~= 1 then do
if symbol(VIO_Variable) == 'LIT' then interpret VIO_Variable' = ""'
Open.VIO_Variable = 1
Pointer.VIO_Variable = 1
EOF.VIO_Variable = 0
return 1
end
else return 0
/**/
/***//** CloseV() **/
CloseV:
parse arg VIO_Variable
If Open.VIO_Variable == 0 then return 0
Open.VIO_Variable = 0
return 1
/**/
/***//** SeekV() **/
SeekV:
parse arg VIO_Variable, VIO_Offset, VIO_Anchor
if Open.VIO_Variable == 1 then do
VIO_Anchor = upper(left(VIO_Anchor, 1))
VIO_Value = Value(VIO_Variable)
select
when VIO_Anchor == 'B' then Pointer.VIO_Variable = VIO_Offset
when VIO_Anchor == 'E' then Pointer.VIO_Variable = length(VIO_Value) + VIO_Offset
otherwise Pointer.VIO_Variable = Pointer.VIO_Variable + VIO_Offset
end
if Pointer.VIO_Variable > length(VIO_Value) then Pointer.VIO_Variable = length(VIO_Value) + 1
if Pointer.VIO_Variable == 0 then Pointer.VIO_Variable = 1
return Pointer.VIO_Variable
end
else return 0
/**/
/***//** ReadVCh() **/
ReadVCh:
parse arg VIO_Variable, VIO_Length
if VIO_Length == '' then VIO_Length = 1
if Open.VIO_Variable == 1 then do
if EOF.VIO_Variable == 0 then do
VIO_Value = Value(VIO_Variable)
VIO_Length = min(VIO_Length, length(VIO_Value) - Pointer.VIO_Variable)
VIO_Ret = substr(VIO_Value, Pointer.VIO_Variable, VIO_Length)
Pointer.VIO_Variable = Pointer.VIO_Variable + VIO_Length
if Pointer.VIO_Variable > length(VIO_Value) then EOF.VIO_Variable = 1
else EOF.VIO_Variable = 0
end
else VIO_Ret = ''
end
else VIO_Ret = ''
return VIO_Ret
/**/
/***//** ReadVLn(RV) **/
ReadVLn:
parse arg VIO_Variable, VIO_Count, VIO_SepChar
if VIO_Count == '' then VIO_Count = 1
if VIO_SepChar == '' then VIO_SepChar = '0a'x
if Open.VIO_Variable == 1 then do
VIO_Value = Value(VIO_Variable)
VIO_Ret = ''
do VIO_i = 1 to VIO_Count
VIO_LF = pos('0a'x, VIO_Value, Pointer.VIO_Variable)
if VIO_LF > 0 then do
VIO_Ret = VIO_Ret''substr(VIO_Value, Pointer.VIO_Variable, VIO_LF - Pointer.VIO_Variable)
Pointer.VIO_Variable = VIO_LF + 1
if VIO_LF = length(VIO_Value) then EOF.VIO_Variable = 1
else EOF.VIO_Variable = 0
end
else do
if Pointer.VIO_Variable < length(VIO_Value) then do
VIO_Ret = VIO_Ret''substr(VIO_Value, Pointer.VIO_Variable)
Pointer.VIO_Variable = length(VIO_Value) + 1
EOF.VIO_Variable = 1
end
end
if EOF.VIO_Variable == 1 then leave
if VIO_i ~= VIO_Count then VIO_Ret = VIO_Ret''VIO_SepChar
end
end
else VIO_Ret = ''
return VIO_Ret
/**/
/***//** WriteVCh() **/
WriteVCh:
parse arg VIO_Variable, VIO_String, VIO_Option
VIO_Value = Value(VIO_Variable)
VIO_Option = upper(left(VIO_Option, 1))
VIO_Length = length(VIO_Value)
if VIO_Option == 'C' then do
VIO_Value = Insert(VIO_String, VIO_Value, Pointer.VIO_Variable - 1)
Pointer.VIO_Variable = Pointer.VIO_Variable + length(VIO_String)
end
else if VIO_Option == 'B' then do
VIO_Value = VIO_String''VIO_Value
Pointer.VIO_Variable = length(VIO_String) + 1
end
else do
VIO_Value = VIO_Value''VIO_String
Pointer.VIO_Variable = length(VIO_Value)
end
interpret VIO_Variable'= VIO_Value'
if length(VIO_Value) = VIO_Length + length(VIO_String) then VIO_Ret = length(VIO_String)
else VIO_Ret = 0
return VIO_Ret
/**/
/***//** WriteVLn() **/
WriteVLn:
parse arg VIO_Variable, VIO_String, VIO_Option
return WriteVCh(VIO_Variable, VIO_String||'0a'x, VIO_Option)
/**/
/***//** EOFV() **/
EOFV:
parse arg VIO_Variable
if Open.VIO_Variable == 1 then return EOF.VIO_Variable
else return 1
/**/
/**/
/***//*** WriteData (WD) ***/
WriteData:
WD_FileOpen = 0
WD_MsgWritten = 0
WD_SepWritten = 0
/* Write non-imageclass variables */
do WD_i = 0 to VariableCount - 1
if value(VariableName.WD_i) ~= Default.WD_i then do
WD_Value = Value(VariableName.WD_i)
if (datatype(WD_Value) == 'CHAR') then do
if pos("'", WD_Value) ~= 0 then WD_Value = '"'WD_Value'"'
else WD_Value = "'"WD_Value"'"
end
call WriteDataLine(VariableName.WD_i' = 'WD_Value)
end
end
/* Write imageclass variables */
do WD_i = 0 to ImgClassCount - 1
if ImageFile.WD_i ~= ScriptDir'Images/' then call WriteDataLine('ImageClass.'ImageClass.WD_i' = 'QuoteIt(ImageFile.WD_i))
end
/* Write highlight variables */
do WD_i = 1 to 14
WD_Month = right(WD_i, 2, '0')
WD_MonthCount = MonthCount.WD_Month
if WD_MonthCount > 0 then do
do WD_j = 1 to WD_MonthCount
if symbol('HighlightData.WD_Month.WD_j') == 'VAR' then do
if WD_SepWritten == 0 then do
call WriteDataLine('/* End Pass One - DO NOT DELETE THIS LINE!!! */')
WD_SepWritten = 1
end
call WriteDataLine(HighlightData.WD_Month.WD_j)
end
end
end
end
call close('DataFile')
return
WriteDataLine:
parse arg WDL_Data
if WD_FileOpen == 0 then do
if PrefsFile == 'Default' then do
if ClassAct == 1 then WDL_File = CAGetFile('CA', GetFileDataGad, SelectPrefs$, ScriptDir'FWCalendar.prefs')
else WDL_File = bguifilereq(ScriptDir'FWCalendar.prefs', SelectPrefs$)
if WDL_File ~= '' then do
WD_FileOpen = open('DataFile', WDL_File, 'W')
if WD_FileOpen ~= 0 then do
PrefsFile = WDL_File
call WriteFile('ENV:FWCalendar', PrefsFile, 'B')
end
else call AddMsg('W', "Couldn't open selected data file ("WDL_File")")
end
end
else WD_FileOpen = open('DataFile', PrefsFile, 'W')
if WD_FileOpen ~= 0 then call writeln('DataFile', '/* Dataversion 'word(sourceline(4), 3)' */')
end
if WD_FileOpen ~= 0 then call writeln('DataFile', WDL_Data)
else do
if WD_MsgWritten == 0 then do
WD_MsgWritten = 1
call AddMsg('W', 'Unable to write to preference file.')
end
end
return
/**/
/***//*** WriteFile (PROCEDURE) ***/
WriteFile: PROCEDURE
parse arg file, var, which
if open('Temp', file, 'W') then do
success = writech('Temp', var)
call close('Temp')
end
if (upper(which) == 'B') & (upper(left(file, 4)) == 'ENV:') then call WriteFile('ENVARC:'substr(file, 5), var)
return success
/**/
/***//*** InitializeVariables (IV) ***/
InitializeVariables:
esc = "1B"x
FSize. = 10
GenCalCount = 22
HighlightCount = 0
ImageCount = 0
ImageHeight. = 0
ImageType. = ''
ImageWidth. = 0
MoonPhase. = ''
UserPrefs = ''
Width. = 100
Spc =' '
NormalWidth.Spc = 0
BoldWidth.Spc = 0
ColorW = 80
ColorH = 10
PGSFilter. = ''
PGSFilter.ILBM = 'IFFILBM'
PGSFilter.JFIF = 'JPEG'
PGSFilter.POST = 'IllustratorEPS'
GfxCmd.Visage = '%s info'
GfxTemplate.Visage = '. "0a"x . ImgDT ImgWidth "x" ImgHeight "x" .'
GfxCmd.ImageDTInfo = '%s'
GfxTemplate.ImageDTInfo = 'ImgDT "-" ImgWidth "x" ImgHeight "x" .'
GfxCmd.PicSize = '%s "%t %w %h"'
GfxTemplate.PicSize = 'ImgDT ImgWidth ImgHeight "0a"x'
GroupCount = 4
PhasesPosn = 1
WeeknumberPosn = 2
JulianPosn = 3
JulianLeftPosn = 4
BothJPosn = 5
SunrisePosn = 6
SunsetPosn = 7
BothSPosn = 8
HistoryPosn = 9
RandomPosn = 10
PosnCount = 10
MXPair.1 = '11111 0011000000 0000100000'
MXPair.2 = '11111 0000011000 0000000100'
MXPair.3 = '11100 1111111100 0000000011'
MXPairCount = 3
Do.1 = 'Phases'
Do.2 = 'Weeknumber'
Do.3 = 'Julian'
Do.4 = 'JulianLeft'
Do.5 = 'BothJ'
Do.6 = 'Sunrise'
Do.7 = 'Sunset'
Do.8 = 'BothS'
Do.9 = 'History'
Do.10 = 'Random'
if App == 'FW' then do
DefaultFont = 'SoftSans'
DefaultBold = 'SoftSans_Bold'
end
else if App == 'PGS' then do
DefaultFont = 'PageStream-Normal'
DefaultBold = 'PageStream-Normal'
end
Date = 0
Weekday = 1
Header = 2
MiniCal = 3
FYMiniCal = 4
Highlight = 5
Extras = 6
SubHeader = 7
FontTypes = 7
D.0 = 'Sunday'
D.1 = 'Monday'
D.2 = 'Tuesday'
D.3 = 'Wednesday'
D.4 = 'Thursday'
D.5 = 'Friday'
D.6 = 'Saturday'
MonthLength.1 = 31
MonthLength.2 = 28
MonthLength.3 = 31
MonthLength.4 = 30
MonthLength.5 = 31
MonthLength.6 = 30
MonthLength.7 = 31
MonthLength.8 = 31
MonthLength.9 = 30
MonthLength.10 = 31
MonthLength.11 = 30
MonthLength.12 = 31
Month.1 = January$
Month.2 = February$
Month.3 = March$
Month.4 = April$
Month.5 = May$
Month.6 = June$
Month.7 = July$
Month.8 = August$
Month.9 = September$
Month.10 = October$
Month.11 = November$
Month.12 = December$
return
/**/
/***//*** SetVariables ***/
SetVariables:
CNotice = 'Created w/ FWCalendar © Ron Goertz'
FSize.4pt = 4
Font.4pt = DefaultFont
DoJulian = upper(DoJulian)
DoJulianLeft = upper(DoJulianLeft)
CalendarBorder = CalendarBorder / 100
CalendarShadow = CalendarShadow / 100
CornerRadius = CornerRadius / 100
DateOffset = DateOffset / 100
HeaderLoc = HeaderLoc / 100
HeaderSize = HeaderSize / 100
MagnifyExtras = MagnifyExtras / 100
MaxImgHeight = MaxImgHeight / 100
MaxImgWidth = MaxImgWidth / 100
MiniCalHeight = MiniCalHeight / 100
MiniCalWidth = MiniCalWidth / 100
MoonRadius = MoonRadius / 100
ShiftLMini = ShiftLMini / 720
ShiftRMini = ShiftRMini / 720
StretchDateH = StretchDateH / 100
StretchDateW = StretchDateW / 100
SubHeaderLoc = SubHeaderLoc / 100
SubHeaderSize = SubHeaderSize / 100
TextAdj = TextAdj / 100
TTextArea = TTextArea / 100
WeekdaySize = WeekdaySize / 100
WTextArea = WTextArea / 100
if (PhaseLib ~= 1) & (DoPhases ~= 0) then do
call AddMsg('W', 'date.library or rexxmathlib.library are required to calculate the moon phases.')
DoPhases = 0
end
if App == 'FW' then do
TextBase = TextAdj
do i = 0 to FontTypes
if Font.i == FilePart(Font.i) then Font.i = CurrentDir'FWFonts/SWOLFonts/'Font.i
if ~exists(Font.i) then do
call AddMsg('W', FilePart(Font.i)" can't be found; "DefaultFont" used instead.")
Font.i = DefaultFont
end
end
if Bold.MiniCal == FilePart(Bold.MiniCal) then Bold.MiniCal = CurrentDir'FWFonts/SWOLFonts/'Bold.MiniCal
if ~exists(Bold.MiniCal) then do
call AddMsg('W', FilePart(Bold.MiniCal)" can't be found; "DefaultBold" used instead.")
Bold.MiniCal = DefaultBold
end
if Bold.FYMiniCal == FilePart(Bold.FYMiniCal) then Bold.FYMiniCal = CurrentDir'FWFonts/SWOLFonts/'Bold.FYMiniCal
if ~exists(Bold.FYMiniCal) then do
call AddMsg('W', FilePart(Bold.FYMiniCal)" can't be found; "DefaultBold" used instead.")
Bold.FYMiniCal = DefaultBold
end
PAGESETUP ORIENT Orientation
if upper(Orientation) == 'WIDE' then TextArea = WTextArea
else TextArea = TTextArea
GETDISPLAYPREFS Measure; UserPrefs = 'DISPLAYPREFS Measure 'result
DISPLAYPREFS Measure Inches
SECTIONSETUP TOP Margin.Top BOTTOM Margin.Bottom INSIDE Margin.Left OUTSIDE Margin.Right
GETPAGESETUP Width Height
parse var result FullWidth FullHeight
end
else if App = 'PGS' then do
TextBase = 1
do i = 0 to FontTypes
do j = 0 to FontList.COUNT - 1
if upper(Font.i) == upper(FontList.j) then leave
end
if j == FontList.COUNT then do
call AddMsg('W', Font.i" can't be found; "DefaultFont" used instead.")
Font.i = DefaultFont
end
end
do j = 0 to FontList.COUNT - 1
if upper(Bold.MiniCal) == upper(FontList.j) then leave
end
if j == FontList.COUNT then do
call AddMsg('W', Bold.MiniCal" can't be found; "DefaultBold" used instead.")
Bold.MiniCal = DefaultBold
end
do j = 0 to FontList.COUNT - 1
if upper(Bold.FYMiniCal) == upper(FontList.j) then leave
end
if j == FontList.COUNT then do
call AddMsg('W', Bold.FYMiniCal" can't be found; "DefaultBold" used instead.")
Bold.FYMiniCal = DefaultBold
end
if upper(Orientation) == 'WIDE' then do
TextArea = WTextArea
Orientation = 'LANDSCAPE'
end
else do
TextArea = TTextArea
Orientation = 'PORTRAIT'
end
if CalType == 1 then DocName = '"'EnteredYear''Mn''Calendar$'"'
else if CalType == 2 then DocName = '"'EnteredYear''Calendars$'"'
else DocName = '"'EnteredYear''Calendar$'"'
PageName = '"FWCalendar by Ron Goertz"'
NEWDOCUMENT DocName
NEWMASTERPAGE PageName PageWidth PageHeight SINGLE Orientation
SETMARGINGUIDES Margin.Left Margin.Right Margin.Top Margin.Bottom MASTERPAGE PageName
SETDIMENSIONS PageWidth PageHeight SINGLE Orientation MASTERPAGE PageName
SETCOLUMNGUIDES 0 0 MASTERPAGE PageName
SETDOCUMENTSTATUS unchanged DOCUMENT DocName
OPENWINDOW '"View 1"' DOCUMENT DocName PAGE 1
GETMEASUREMENTS COORDINATE stemc RELATIVE rel TEXT tex FROM fro
UserPrefs = 'SETMEASUREMENTS COORDINATE 'stemc.horizontal stemc.vertical' RELATIVE 'rel' TEXT 'tex' FROM 'fro
SETMEASUREMENTS COORDINATE Inches Sameas RELATIVE Sameas TEXT Points FROM Page
GETMARGINGUIDES temp MASTERPAGE PageName
if rc == 0 then do
Margin.Left = temp.inside
Margin.Right = temp.outside
Margin.Top = temp.top
Margin.Bottom = temp.bottom
end
GETDIMENSIONS temp MASTERPAGE PageName
CmdSuccess = rc
if Orientation = 'LANDSCAPE' then do
if CmdSuccess == 0 then do
FullWidth = temp.height
FullHeight = temp.width
end
else do
FullWidth = PageHeight
FullHeight = PageWidth
end
end
else do
if CmdSuccess == 0 then do
FullWidth = temp.width
FullHeight = temp.height
end
else do
FullWidth = PageWidth
FullHeight = PageHeight
end
end
CURRENTWINDOW; winName = '"'RESULT'"'
end
if App == 'FW' then do
VIEW 20
end
else if App == 'PGS' then do
if DoHide == 1 then HIDEWINDOW
else DISPLAY SCALE 25
REFRESH OFF
end
if CalType == 1 then do
EventCount = GenCalCount + MonthLength.Month + DoMiniCals * (MonthLength.NextMonth + MonthLength.PrevMonth + 4)
Gen$ = BuildString(GeneratingM$, GenMVars)
end
else if CalType == 2 then do
if EndMonth < Month then EndMonth = EndMonth + 12
MonthCount = EndMonth - Month + 1
EventCount = 7 + (MonthCount * 54) + DoMiniCals * (MonthCount * 62)
Gen$ = BuildString(GeneratingY$, GenYVars)
end
else do
EventCount = 365 + 24
Gen$ = BuildString(GeneratingY$, GenYVars)
end
Req = OpenBusy(Gen$, EventCount)
PrintWidth = FullWidth - Margin.Left - Margin.Right
PrintHeight = FullHeight - Margin.Top - Margin.Bottom
if UpdateBusy(Req, 1) == -1 then call Cleanup
if CalType < 3 then do
Height.4pt = GetHeight(4pt)
if ((PrintHeight - Height.4pt - (TextArea * PrintHeight))/5 * 8) >= 4 then do
DoCopyright = 1
PrintHeight = PrintHeight - Height.4pt
end
else DoCopyright = 0
CalendarBorder = CalendarBorder * PrintWidth
CalendarShadow = CalendarShadow * PrintWidth
PrintWidth = PrintWidth - 2 * CalendarBorder - CalendarShadow
PrintHeight = PrintHeight - 2 * CalendarBorder - CalendarShadow
Margin.Left = Margin.Left + CalendarBorder
BoxWidth = PrintWidth/7
CalRight = Margin.Left + BoxWidth * 7
TextArea = TextArea * PrintHeight
CalTop = TextArea + Margin.Top + CalendarBorder
BoxHeight = (PrintHeight - TextArea)/5
MoonRadius = BoxHeight * MoonRadius
CRadius = CornerRadius * BoxWidth
CurveOffset = DateOffset * BoxWidth + CRadius * .25
DateOffset = DateOffset * BoxWidth
MiniCalHeight = TextArea * MiniCalHeight
MiniCalWidth = MiniCalHeight * MiniCalWidth
FSize.Highlight = BoxHeight/HighlightRows * 72
FSize.Extras = FSize.Highlight * MagnifyExtras
FSize.Date = BoxHeight/HighlightRows * 72 * StretchDateH
Width.Date = 100 * StretchDateW / StretchDateH
FSize.Weekday = (TextArea - MiniCalHeight) * WeekdaySize * 72
FSize.Header = TextArea * HeaderSize * 72
FSize.SubHeader = TextArea * SubHeaderSize * 72
if App == 'FW' then do
FSize.MiniCal = MiniCalHeight/6 * 72
do i = 0 to FontTypes
FSize.i = min(max(trunc(FSize.i), 4), 360)
Width.i = min(max(trunc(Width.i), 4), 255)
end
end
else if App == 'PGS' then FSize.MiniCal = MiniCalHeight/7 * 72
Height.Highlight = FSize.Highlight / 4 * Height.4pt * Leading/100
Height.Date = FSize.Date / 4 * Height.4pt * Leading/100
Height.Weekday = FSize.Weekday / 4 * Height.4pt * Leading/100
Height.Header = FSize.Header / 4 * Height.4pt * Leading/100
Height.MiniCal = FSize.MiniCal / 4 * Height.4pt * Leading/100
Height.Extras = FSize.Extras / 4 * Height.4pt * Leading/100
Height.SubHeader = FSize.SubHeader / 4 * Height.4pt * Leading/100
if DoMiniCals == 1 then call GetMiniMax(MiniCal)
end
else do
Height.4pt = GetHeight(4pt)
MiniCalSpacing = MiniCalSpacing / 100
if ((((PrintHeight - (3 * MiniCalSpacing) - Height.4pt) / 4 ) / 7) * 72) >= 4 then DoCopyright = 1
else DoCopyright = 0
MiniCalSpacing = PrintWidth * MiniCalSpacing
MiniCalWidth = (PrintWidth - 2 * MiniCalSpacing)/3
FSize.FYMiniCal = (((PrintHeight - (3 * MiniCalSpacing) - (Height.4pt * DoCopyright)) / 4 ) / 7) * 72
if App == 'FW' then FSize.FYMiniCal = max(trunc(FSize.FYMiniCal), 4)
Height.FYMiniCal = FSize.FYMiniCal / 4 * Height.4pt * Leading/100
call GetMiniMax(FYMiniCal)
end
if UpdateBusy(Req, 1) == -1 then call Cleanup
if App == 'FW' then do
FIRSTOBJECT; ObjID = result
SELECTOBJECT ObjID
do forever
NEXTOBJECT ObjID; ObjID = result
if ObjID == 0 then leave
SELECTOBJECT ObjID MULTIPLE
end
DELETEOBJECT
end
if UpdateBusy(Req, 1) == -1 then call Cleanup
VariablesSet = 1
if ErrorCount > 0 then call Cleanup
return
/**/
/***//*** TranslationStrings () ***/
TranslationStrings:
Sunday$ = 'Sunday'
Monday$ = 'Monday'
Tuesday$ = 'Tuesday'
Wednesday$ = 'Wednesday'
Thursday$ = 'Thursday'
Friday$ = 'Friday'
Saturday$ = 'Saturday'
January$ = 'January'
February$ = 'February'
March$ = 'March'
April$ = 'April'
May$ = 'May'
June$ = 'June'
July$ = 'July'
August$ = 'August'
September$ = 'September'
October$ = 'October'
November$ = 'November'
December$ = 'December'
AddEvent$ = 'Add Event'
AddIC$ = '+IC'
All$ = 'All'
BiOrWeekly$ = '(Bi)Weekly'
Biweekly$ = 'Biweekly'
Bottom$ = 'Bottom'
BoxColor$ = 'Box'
BoxDates$ = 'Box Dates'
Boxed$ = '_Boxed'
Calendar$ = 'Calendar'
Calendars$ = 'Calendars'
Cancel$ = '_Cancel'
CantFind$ = "can't be found"
Center$ = 'Center'
Clear$ = 'Clear'
Color$ = 'Color'
Colors$ = 'Colors'
Comment$ = 'Comment'
Critical$ = 'Critical error'
DailyColors$ = 'Use daily colors'
DeleteEvent$ = 'Delete Event'
Done$ = 'Done'
Easter$ = 'Easter'
End$ = 'End'
EnterEvent$ = 'You must enter an event...'
EnterEventInfo$ = 'Enter event information'
EnterNewIC$ = 'Enter new ImageClass'
EnterStartdate$ = 'You must enter a start date...'
Even$ = 'Even'
Event$ = 'Event'
Extended$ = 'Extended'
File$ = 'File'
First$ = 'First'
Fixed$ = 'Fixed'
Floating$ = 'Floating'
Font$ = 'Font'
Fonts$ = 'Fonts'
ForDetails$ = 'for details'
ForwardContent$ = 'Forward contents of output to'
ForwardLog$ = 'Forward log file to'
Fourth$ = 'Fourth'
Frequency$ = 'Frequency'
GeneratingM$ = 'Generating %s %s calendar'
GeneratingY$ = 'Generating %s calendar'
Go$ = 'Go'
Header$ = '%s %s'
HighlightEd$ = 'Highlight Editor'
Highlights$ = 'Highlights'
History$ = 'History'
Holiday$ = 'Holiday'
Images$ = 'Images'
Julian$ = 'Julian'
JulJulLeft$ = 'Jul/Jul Left'
JulLeft$ = 'Jul Left'
Last$ = 'Last'
Left$ = 'Left'
Line$ = '_Line'
Load$ = '_Load'
MatchColors$ = 'Date Color = Highlight Color'
MiniCals$ = 'MiniCals'
MiscVar$ = 'Miscellaneous Variables'
MultiMonth$ = 'Multi-Month'
MustUse$ = 'You must use the gadget to'||'0a'x||'the right for this value.'
NextDay$ = 'Next day'
Noncritical$ = 'Noncritical warning'
None$ = 'None'
NotClear$ = '<'Clear$'> can only be used for "Background." variables...'
Note$ = 'Notes'
NoteBox$ = 'Note box'
Notice$ = 'notice'
Odd$ = 'Odd'
OK$ = '_OK'
OK2$ = 'OK'
Once$ = 'Once'
Options$ = 'Options'
OptLayout$ = 'Options & Layout'
OrientMarg$ = 'Orientation & Margins'
Phases$ = 'Phases'
PleaseWait$ = 'please wait'
PrepReq$ = 'Preparing requester'
PreviousDay$ = 'Prev day'
ProcessEvents$ = 'Processing events'
Random$ = 'Random'
Reset$ = '_Reset'
Right$ = 'Right'
RiseSet$ = 'Rise/Set'
SaveAs$ = '_Save as'
Second$ = 'Second'
See$ = 'see'
SeeOutput$ = 'see the output above for details'
SeeShell$ = 'see the shell output for details'
SelectApp$ = 'Select application'
SelectFile$ = 'Select data file'
SelectFont$ = 'Select font'
SelectImage$ = 'Select image'
SelectPrefs$ = 'Select name for prefs file'
SingleMonth$ = 'Single Month'
Start$ = 'Start'
SubHeader$ = ''
Sunrise$ = 'Sunrise'
Sunset$ = 'Sunset'
Tall$ = 'Tall'
TextColor$ = 'Text'
Third$ = 'Third'
Top$ = 'Top'
TopLong$ = 'Extra week at top'
Type$ = 'Type'
Unable$ = 'if you are unable to resolve the problem.'
VarGUITitle$ = 'Set desired variables'
Variables$ = 'Variables'
Weekend$ = 'Weekend'
Weekly$ = 'Weekly'
WeekNumber$ = 'Week Number'
WeekType$ = 'Week Type'
WholeYear$ = 'Whole Year'
Wide$ = 'Wide'
Help$ = 'Help message'
Help$.ClickTabHelp = 'Different tabs display*ndifferent variables'
Help$.MiniCalsGadHelp = 'Include mini-calendars showing*nthe previous & next months'
Help$.HighlightsGadHelp = 'Include highlights on*nthe generated calendar'
Help$.ImagesGadHelp = 'Include images on*nthe generated calendar'
Help$.BoxDatesGadHelp = 'Surround day numbers*nwith boxes'
Help$.ExtendedGadHelp = 'Include days from the previous*nand next months on the*ngenerated calendar'
Help$.TopLongGadHelp = 'Include days from the sixth week*nat the top of the calendar'
Help$.NoteBoxGadHelp = 'Include an area to write notes*nwhere no dates are printed'
Help$.TopMargGadHelp = "Set calendar's top margin*nRemember to <RETURN>"
Help$.LeftMargGadHelp = "Set calendar's left margin*nRemember to <RETURN>"
Help$.OrientationGadHelp = "Set calendar's orientation"
Help$.RightMargGadHelp = "Set calendar's right margin*nRemember to <RETURN>"
Help$.BottomMargGadHelp = "Set calendar's bottom margin*nRemember to <RETURN>"
Help$.FontVarGadHelp = 'Select the font variable to set'
Help$.FontValGadHelp = 'Displays the choosen font value'
Help$.ChooseFontGadHelp = 'Select the desired font'
Help$.ColorVarGadHelp = 'Select the color variable to set'
Help$.CycleColorVarGadHelp = 'Cycle through the color variables*nShift to reverse cycle'
Help$.ColorValGadHelp = 'Select the desired color'
Help$.MatchColorsGadHelp = 'Use the highlight text color*nfor the date/date box'
Help$.DailyColorsGadHelp = 'Use the Color.(Weekday) colors*nfor the date/date box'
Help$.HighlightEditGadHelp = 'Bring up the*nHighlight Editor'
Help$.MiscVarGadHelp = 'Select the desired*nmiscellaneous variable'
Help$.CycleMiscVarGadHelp = 'Cycle through the miscellaneous variables*nShift to reverse cycle'
Help$.MiscValGadHelp = 'Enter the desired variable value'
Help$.ChooseValGadHelp = 'Used only for selecting files/paths'
Help$.AddImageClassGadHelp = 'Add an ImageClass variable'
Help$.Extra3Help = "Select extra to be printed*nin calendar's top-center"
Help$.Extra4Help = "Select extra to be printed*nin calendar's top-right"
Help$.Extra0Help = "Select extra to be printed*nin calendar's bottom-left"
Help$.Extra1Help = "Select extra to be printed*nin calendar's bottom-center"
Help$.Extra2Help = "Select extra to be printed*nin calendar's bottom-right"
Help$.CalendarTypeGadHelp = 'Select calendar type'
Help$.EndMonthGadHelp = 'Select desired end month'
Help$.StartMonthGadHelp = 'Select desired start month'
Help$.MonthGadHelp = 'Select desired month'
Help$.YearGadHelp = 'Select or enter desired year'
Help$.GoGadHelp = 'Begin generation of calendar'
Help$.ResetGadHelp = 'Reset all variables to defaults'
Help$.LoadGadHelp = 'Load a new preference file'
Help$.SaveAsGadHelp = 'Save current settings to*na new preference file'
Help$.CancelGadHelp = 'Cancel FWCalendar'
Help$.EH_EventGadHelp = 'Enter the Highlight as it*nwill show up on calendar'
Help$.EH_ChooseEventGadHelp = 'Select Image file to be printed on calendar'
Help$.EH_ListEventGadHelp = 'List all Highlights*nfor current month'
Help$.EH_CycleEventGadHelp = 'Cycle through all Highlights*nfor current month'
Help$.EH_CommentGadHelp = 'Enter optional comment'
Help$.EH_MonthGadHelp = 'Select month to work with'
Help$.ExtraDHelp = 'Select the date on*nwhich the Highlight falls'
Help$.LD = 'Indicates the Highlight always falls*non the last day of the month'
Help$.EH_ColorGadHelp = 'Select color to be*nused for the Highlight'
Help$.EH_HLTypeGadHelp = 'Select the Highlight type'
Help$.EH_WeekNumberGadHelp = 'Select which week a floating*nHighlight occurs in'
Help$.EH_WeekTypeGadHelp = 'Select frequency of weekly Highlights'
Help$.EH_WeekendGadHelp = 'Determine whether or not the*nHighlight can fall on a weekend'
Help$.EH_HolidayGadHelp = 'Treat the Highlight as a holiday'
Help$.EH_EasterGadHelp = 'The number of days before or*nafter Easter for the Highlight'
Help$.EH_AddEventGadHelp = 'Add a new Highlight'
Help$.EH_DeleteEventGadHelp = 'Delete the currently*ndisplayed Highlight'
Help$.EH_DoneGadHelp = 'Save all changes to Highlights'
Help$.GE_EventTypeGadHelp = 'Select to enter Event or*nuse an Event file'
Help$.GE_EventGadHelp = 'Enter Event or display Event file'
Help$.GE_FontNameGadHelp = 'Display font to be used'
Help$.GE_FontSizeGadHelp = 'Enter font size to use'
Help$.GE_ChooseFontGadHelp = 'Select font to be used'
Help$.GE_ResetGadHelp = 'Reset font and font size'
Help$.GadIDHelp = 'Enter Event start and end dates'
Help$.GE_StartGadHelp = 'Display Event start date'
Help$.GE_EndGadHelp = 'Display Event end date'
Help$.GE_TextColorGadHelp = 'Select color to be*nused for Event text'
Help$.GE_LineGadHelp = 'Select row on which*nEvent will be printed'
Help$.GE_BoxedGadHelp = 'Surround Event with a box'
Help$.GE_BoxColorGadHelp = 'Select color for box*nsurrounding Event'
Help$.GE_FrequencyGadHelp = 'Select frequency of Event'
Help$.GE_OKGadHelp = 'Use entered data to add*nEvent to calendar'
Help$.GE_CancelGadHelp = 'Cancel FWCAddEvent'
return 0
/**/
/***//*** VarList () ***/
VarList:
AddEventRows = 9
AdjustDST = 1
AltColor.Date = Black$
AltColor.Extended = Black$
AltColor.Highlight = Black$
AltColor.HighlightH = Black$
AltColor.History = Black$
AltColor.Julian = Black$
AltColor.Random = Black$
AltColor.Sunrise = Black$
AltColor.Sunset = Black$
AltColor.WeekNumber = Black$
Background.AddEvent = White$
Background.CalShadow = Black$
Background.Highlight = '<'Clear$'>'
Background.HighlightH = '<'Clear$'>'
Background.MiniCal = White$
Background.MiniCalShadow = Black$
Background.NoteBox = '<'Clear$'>'
Background.Standard = '<'Clear$'>'
Background.Weekend = '<'Clear$'>'
BelzierFactor = .55
Bold.MiniCal = DefaultBold
Bold.FYMiniCal = DefaultBold
CalendarBorder = 0
CalendarShadow = 0
CenterHistory = 1
CenterMiniDates = 1
CenterRandom = 1
Color.Sunday = Black$
Color.Monday = Black$
Color.Tuesday = Black$
Color.Wednesday = Black$
Color.Thursday = Black$
Color.Friday = Black$
Color.Saturday = Black$
Color.AddEvent = Black$
Color.Date = Black$
Color.Extended = Black$
Color.Header = Black$
Color.Highlight = Black$
Color.HighlightH = Black$
Color.History = Black$
Color.Julian = Black$
Color.MiniCal = Black$
Color.Moon = Black$
Color.NoteBox = Black$
Color.Random = Black$
Color.SubHeader = Black$
Color.Sunrise = Black$
Color.Sunset = Black$
Color.Weekday = Black$
Color.WeekNumber = Black$
CornerRadius = 0
DateOffset = 2
DoDailyColors = 0
DoDateBox = 0
DoExtended = 1
DoHide = 0
DoHighlights = 0
DoHistory = ''
DoImages = 0
DoJulian = ''
DoJulianLeft = ''
DoMatchColors = 0
DoMiniCals = 1
DoNoteBox = 0
DoPhases = ''
DoRandom = ''
DoSunRise = ''
DoSunSet = ''
DoTopExtraWk = 0
DoWeekNumber = ''
FinalView = 75
Font.Date = DefaultFont
Font.Extras = DefaultFont
Font.Header = DefaultFont
Font.Highlight = DefaultFont
Font.MiniCal = DefaultFont
Font.FYMiniCal = DefaultFont
Font.Weekday = DefaultFont
Font.SubHeader = DefaultFont
ForceBGUI = 0
GenMVars = 'Month.Month EnteredYear'
GenYVars = 'EnteredYear'
GfxApp = 'Visage'
GfxAppPath = ''
HeaderLoc = 9
HeaderSize = 50
Header$ = '%s %s'
HeaderVars = 'Month.Month Year'
HelpTime = 4
HighlightRows = 9
HostScreen = ''
LaunchM = ''
LaunchY = ''
Leading = 100
Line.AddEvent = Black$
Line.CalBorder = Black$
Line.Extended = Black$
Line.Grid = Black$
Line.MiniCal = Black$
Line.NoteBox = Black$
MagnifyExtras = 100
Margin.Bottom = 0
Margin.Left = 0
Margin.Right = 0
Margin.Top = 0
MinHistoryWidth = 70
MinRandomWidth = 70
MinWidth = 80
MaxImgHeight = 75
MaxImgWidth = 75
MiniCalHeight = 60
MiniCalSpacing = 0.5
MiniCalWidth = 200
MoonRadius = 10
Orientation = 'Wide'
PrefsName = 'Default'
ShadowType = 'P'
ShiftLMini = 0
ShiftRMini = 0
StartWeek = 0
StretchDateH = 100
StretchDateW = 100
SubHeaderLoc = 0
SubHeaderSize = 0
SubHeader$ = ''
SubHeaderVars = ''
SunCalcPath = ''
Text.Julian = ''
Text.Sunrise = ''
Text.Sunset = ''
Text.WeekNumber = ''
TextAdj = 77
TTextArea = 15
WeekdaySize = 50
WTextArea = 20
return
/**/